(105) Excel de, Oda planı (Çalışanların isimlerine tıklayınca, Oda resminde fotoğraflarının çıkması)
Gemini ye Kod tarifi:
Excel makro kodu ver.
Açılışta tüm resimleri en arkaya gönder.
Resim a1, Resim a2, Resim a3, Resim a4, Resim a5, Resim a6 en öne getir. Geriye kalan tüm resimleri en arkaya gönder.
A1 hücresine tıklanırsa da aynı işlemi yap. (Resim a1, Resim a2, Resim a3, Resim a4, Resim a5, Resim a6 en öne getir. Geriye kalan tüm resimleri en arkaya gönder.)
B6:H10 hücrelerine tıklanırsa da aynı işlemi yap (Resim a1, Resim a2, Resim a3, Resim a4, Resim a5, Resim a6 en öne getir. Geriye kalan tüm resimleri en arkaya gönder.)
B6:H10 arasında birleştirilmiş hücreler olsa da, her hangi birine tıklanırsa, hücrelerine tıklanırsa da aynı işlemi yap (Resim a1, Resim a2, Resim a3, Resim a4, Resim a5, Resim a6 en öne getir. Geriye kalan tüm resimleri en arkaya gönder.)
B2 hücresine tıklanırsa, (Resim a1, Resim a2, Resim a3, Resim a4, Resim a5, Resim a6, Resim x1 en öne getir. geriye kalan resimleri en arkaya gönder)
B3:B4 arasında birleştirilmiş hücreler olsa da, hücresine tıklanırsa, (Resim a1, Resim a2, Resim a3, Resim a4, Resim a5, Resim a6, Resim x2 en öne getir. geriye kalan resimleri en arkaya gönder)
C2 hücresine tıklanırsa, (Resim a1, Resim a2, Resim a3, Resim a4, Resim a5, Resim a6, Resim x3 en öne getir. geriye kalan resimleri en arkaya gönder)
C3:C4 arasında birleştirilmiş hücreler olsa da, hücresine tıklanırsa, (Resim a1, Resim a2, Resim a3, Resim a4, Resim a5, Resim a6, Resim x4 en öne getir. geriye kalan resimleri en arkaya gönder)
D2 hücresine tıklanırsa, (Resim a1, Resim a2, Resim a3, Resim a4, Resim a5, Resim a6, Resim x5 en öne getir. geriye kalan resimleri en arkaya gönder)
D3 hücresine tıklanırsa, (Resim a1, Resim a2, Resim a3, Resim a4, Resim a5, Resim a6, Resim x6 en öne getir. geriye kalan resimleri en arkaya gönder)
D4 hücresine tıklanırsa, (Resim a1, Resim a2, Resim a3, Resim a4, Resim a5, Resim a6, Resim x7 en öne getir. geriye kalan resimleri en arkaya gönder)
E2:E4 arasında birleştirilmiş hücreler olsa da, hücresine tıklanırsa, (Resim a1, Resim a2, Resim a3, Resim a4, Resim a5, Resim a6, Resim x8 en öne getir. geriye kalan resimleri en arkaya gönder)
F2:G2 arasında birleştirilmiş hücreler olsa da, hücresine tıklanırsa, (Resim a1, Resim a2, Resim a3, Resim a4, Resim a5, Resim a6, Resim x9 en öne getir. geriye kalan resimleri en arkaya gönder)
F3:G3 arasında birleştirilmiş hücreler olsa da, hücresine tıklanırsa, (Resim a1, Resim a2, Resim a3, Resim a4, Resim a5, Resim a6, Resim x10 en öne getir. geriye kalan resimleri en arkaya gönder)
F4:G4 arasında birleştirilmiş hücreler olsa da, hücresine tıklanırsa, (Resim a1, Resim a2, Resim a3, Resim a4, Resim a5, Resim a6, Resim x11 en öne getir. geriye kalan resimleri en arkaya gönder)
H2:I4 arasında birleştirilmiş hücreler olsa da, hücresine tıklanırsa, (Resim a1, Resim a2, Resim a3, Resim a4, Resim a5, Resim a6, Resim x12 en öne getir. geriye kalan resimleri en arkaya gönder)
Bu Çalışma Kitabı:
Private Sub Workbook_Open()
' Dosya açıldığında Sayfa1 üzerindeki düzeni başlatır
Call ResimDuzenle(Sheets("Sayfa1").Range("A1"))
End Sub
Sayfa1:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Birden fazla hücre seçilirse (veya birleştirilmiş hücre seçilirse)
' sadece ilk hücreyi baz alarak işlemi yürütür.
Call ResimDuzenle(Target.Cells(1, 1))
End Sub
Module1:
Sub ResimDuzenle(Target As Range)
Dim ws As Worksheet: Set ws = Target.Worksheet
Dim shp As Shape
Dim ekstraResim As String
ekstraResim = ""
On Error Resume Next
' 1. TÜM resimleri en arkaya gönder
For Each shp In ws.Shapes
shp.ZOrder msoSendToBack
Next shp
' 2. Hücre Kontrolleri (Birleştirilmiş hücre uyumlu)
If Not Intersect(Target, ws.Range("A1")) Is Nothing Or _
Not Intersect(Target, ws.Range("B6:H10")) Is Nothing Then
' Sadece a1-a6 öne gelecek, ekstra resim yok.
ElseIf Not Intersect(Target, ws.Range("B2")) Is Nothing Then: ekstraResim = "Resim x1"
ElseIf Not Intersect(Target, ws.Range("B3:B4")) Is Nothing Then: ekstraResim = "Resim x2"
ElseIf Not Intersect(Target, ws.Range("C2")) Is Nothing Then: ekstraResim = "Resim x3"
ElseIf Not Intersect(Target, ws.Range("C3:C4")) Is Nothing Then: ekstraResim = "Resim x4"
ElseIf Not Intersect(Target, ws.Range("D2")) Is Nothing Then: ekstraResim = "Resim x5"
ElseIf Not Intersect(Target, ws.Range("D3")) Is Nothing Then: ekstraResim = "Resim x6"
ElseIf Not Intersect(Target, ws.Range("D4")) Is Nothing Then: ekstraResim = "Resim x7"
ElseIf Not Intersect(Target, ws.Range("E2:E4")) Is Nothing Then: ekstraResim = "Resim x8"
ElseIf Not Intersect(Target, ws.Range("F2:G2")) Is Nothing Then: ekstraResim = "Resim x9"
ElseIf Not Intersect(Target, ws.Range("F3:G3")) Is Nothing Then: ekstraResim = "Resim x10"
ElseIf Not Intersect(Target, ws.Range("F4:G4")) Is Nothing Then: ekstraResim = "Resim x11"
ElseIf Not Intersect(Target, ws.Range("H2:I4")) Is Nothing Then: ekstraResim = "Resim x12"
End If
' 3. Sabit "a1, a2, a3, a4, a5, a6" resimlerini öne getir
Dim i As Integer
For i = 1 To 6
ws.Shapes("Resim a" & i).ZOrder msoBringToFront
Next i
' 4. Eğer bir "x" resmi belirlendiyse onu en öne getir
If ekstraResim <> "" Then
ws.Shapes(ekstraResim).ZOrder msoBringToFront
End If
On Error GoTo 0
End Sub