(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.)
"J10" hücresine tıklayınca, "Resim x1" den "Resim x12" ye kadar tüm resimleri en öne getir.
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
Sub Kapat()
Application.WindowState = xlMaximized
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"", False)"
Application.DisplayFormulaBar = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Activate
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
Next ws
ThisWorkbook.Sheets(1).Activate
ActiveSheet.Range("A1").Select
ActiveWorkbook.Save
End Sub
Sub Ac()
Application.WindowState = xlMaximized
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"", True)"
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Activate
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = True
Next ws
Application.DisplayFormulaBar = True
ThisWorkbook.Sheets(1).Activate
Range("A1").Select
ActiveWorkbook.Save
End Sub
Sub OK_ResimleriGoruntule()
Dim ws As Worksheet
Dim shp As Shape
Dim i As Integer
' Makronun çalıştığı aktif sayfayı ayarla
Set ws = ActiveSheet
' Hata kontrolü: Resim isimleri hatalıysa makro durmasın
On Error Resume Next
' 1. TÜM resimleri önce en arkaya gönder (Temizlik)
For Each shp In ws.Shapes
' Sadece resimleri arkaya at, butonu (şekli) arkaya atmasın isterseniz
' aşağıdaki kontrolü kullanabilirsiniz.
If shp.Name <> "OK" Then
shp.ZOrder msoSendToBack
End If
Next shp
' 2. Önce temel "Resim a1"den "Resim a6"ya kadar olanları öne getir
For i = 1 To 6
ws.Shapes("Resim a" & i).ZOrder msoBringToFront
Next i
' 3. Sonra "Resim x1"den "Resim x12"ye kadar olanları EN ÖNE getir
' (Böylece "a" serisinin de üstünde görünürler)
For i = 1 To 12
ws.Shapes("Resim x" & i).ZOrder msoBringToFront
Next i
On Error GoTo 0
End Sub
Module1:
Sub ResimDuzenle(Target As Range)
Dim ws As Worksheet: Set ws = Target.Worksheet
Dim shp As Shape
Dim i As Integer
' Hata kontrolü: Resim bulunamazsa durmasın
On Error Resume Next
' 1. TÜM resimleri en arkaya gönder (Temizlik)
For Each shp In ws.Shapes
shp.ZOrder msoSendToBack
Next shp
' 2. ÖZEL DURUM: J10 Hücresine tıklandıysa
If Not Intersect(Target, ws.Range("J10")) Is Nothing Then
' Önce temel a serisini öne getir
For i = 1 To 6
ws.Shapes("Resim a" & i).ZOrder msoBringToFront
Next i
' Sonra x1-x12 serisini EN ÖNE getir (Böylece a serisinin de üstünde kalırlar)
For i = 1 To 12
ws.Shapes("Resim x" & i).ZOrder msoBringToFront
Next i
Exit Sub ' J10 işlemi bitti, aşağıyı kontrol etmeye gerek yok
End If
' 3. DİĞER HÜCRE KONTROLLERİ
Dim ekstraResim As String
ekstraResim = ""
If Not Intersect(Target, ws.Range("A1")) Is Nothing Or _
Not Intersect(Target, ws.Range("B6:I10")) Is Nothing Then
' İşlem yapmaya gerek yok, sadece a serisi öne gelecek
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
' 4. Standart a1-a6 resimlerini öne getir
For i = 1 To 6
ws.Shapes("Resim a" & i).ZOrder msoBringToFront
Next i
' 5. Eğer bir x resmi seçildiyse onu en üste koy
If ekstraResim <> "" Then
ws.Shapes(ekstraResim).ZOrder msoBringToFront
End If
On Error GoTo 0
End Sub