Option Explicit 
    
  Sub AÇIKLAMAYA_RESİM_EKLE() 
      Dim X As Long, AÇIKLAMA As Comment, DOSYA_YOLU As String 
      Dim RESİM As Object, GENİŞLİK As Integer, YÜKSEKLİK As Integer 
       
      Application.ScreenUpdating = False 
       
      For X = 2 To Cells(Rows.Count, 1).End(3).Row 
          If Cells(X, 1) <> "" Then 
              DOSYA_YOLU = "C:\Users\emin\Desktop\Rehber\foto\" & Cells(X, 1) & ".jpg" 
               
              Cells(X, 1).ClearComments 
              Set AÇIKLAMA = Cells(X, 1).AddComment 
              AÇIKLAMA.Text Text:="" 
               
              If Dir(DOSYA_YOLU) <> "" Then 
                  Set RESİM = ActiveSheet.Pictures.Insert(DOSYA_YOLU) 
                  With RESİM 
                      GENİŞLİK = .Width 
                      YÜKSEKLİK = .Height 
                      .Delete 
                  End With 
                   
                  With AÇIKLAMA.Shape 
                      .Fill.UserPicture DOSYA_YOLU 
                      .Width = GENİŞLİK 
                      .Height = YÜKSEKLİK 
                  End With 
   
              Else 
                   
                  With AÇIKLAMA 
                      .Text Text:=Chr(10) & Chr(10) & "RESİM BULUNAMADI !" 
                      .Shape.Fill.ForeColor.SchemeColor = 10 
                      .Shape.TextFrame.Characters.Font.Bold = True 
                      .Shape.TextFrame.Characters.Font.ColorIndex = 2 
                  End With 
                   
              End If 
          End If 
      Next 
       
      Application.ScreenUpdating = True 
       
      MsgBox "İşleminiz tamamlanmıştır.", vbInformation 
  End Sub