Sub ACIKLAMAYA_RESIM_EKLE()
Set dosya = CreateObject("Scripting.FileSystemObject")
Set g = ThisWorkbook.Sheets("Giriş")
g.Range("S4:S" & Rows.Count).ClearContents
For Each shf In ThisWorkbook.Sheets
If Not shf.[F1].Value = Empty Then
shf.Rows.Hidden = False
shf.Cells.ClearComments
For sat = 3 To shf.Cells(Rows.Count, 2).End(3).Row Step 3
For sut = 2 To 10 Step 2
With shf.Cells(sat, sut)
If .Text <> "" Then
yol_isim_uzanti = ThisWorkbook.Path & "\" & .Text & ".jpg"
resim_varmi = dosya.FileExists(yol_isim_uzanti)
If resim_varmi = False Then
yol_isim_uzanti = ThisWorkbook.Path & "\YOK.jpg"
gsat = WorksheetFunction.Max(4, g.Cells(Rows.Count, "S").End(3).Row + 1)
g.Cells(gsat, "S") = shf.[F1] & " - " & shf.Cells(sat, sut).Value & " - " & shf.Cells(sat + 1, sut)
End If
Set aciklama_metni = .Comment
.ClearComments
Set aciklama = .AddComment
aciklama.Shape.Fill.UserPicture yol_isim_uzanti
With .Comment.Shape
.Width = shf.Cells(sat, sut).Width - 2: .Height = shf.Cells(sat, sut).Height - 2
.Top = shf.Cells(sat, sut).Top + 1: .Left = shf.Cells(sat, sut).Left + 1
End With
.Comment.Visible = True
Else: say = say + 1
End If
End With
Next
If say = 5 Then shf.Rows(sat - 1 & ":" & sat + 1).Hidden = True
say = 0
Next
End If
Next: g.Columns("S").AutoFit
MsgBox "Resimler hücre açıklamalarına eklendi..", vbInformation, "..:: Ömer BARAN ::.."
End Sub