Açıklama Bölümüne Resim Ekleme

[serkanholep]

Analiz Programımda hocalarımızdan biri şunu istedi. öğrenci isminin üzerine gidildiğinde öğrencinin numarası ile bir klasörde ki aynı isimli resmi açıklama bölümünde gösterebilirmi program

yani açıklamada yazı değil resim olabilir mi

 

[hamitcan]

Aşağıdaki linki inceleyin.
http://www.excel.web.tr/f136/personel-bilgileri-resimli-rnekleri-t22790.html

 

[serkanholep]

Aşağıdaki linki inceleyin.
http://www.excel.web.tr/f136/personel-bilgileri-resimli-rnekleri-t22790.html

tek tek hepsine baktım ama benim istediğim mevcut değil

açıklama bölümüne resim eklemek istiyorum ama bulunduğu hücrenin numarasını alıp o numaralı jpg dosyasını göstersin

 

[serkanholep]

Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
Sub InsertComment()
Dim rngList As Range
Dim c As Range
Dim cmt As Comment
Dim strPic As String

On Error Resume Next

'change this to the range that contains the file names in your workbook
Set rngList = Range("A1:A5")

'change this to the folder path for your picture files
strPic = "C:\Data\"

If Right(strPic, 1) <> "\" Then
strPic = strPic & "\"
End If

For Each c In rngList
With c.Offset(0, 1)
Set cmt = .Comment
If cmt Is Nothing Then
Set cmt = .AddComment
End If
With cmt
.Text Text:=""
.Shape.Fill.UserPicture strPic & c.Value
.Visible = False
End With
End With
Next c

End Sub

bu kodu anlatabilecek var mı

 

[hamitcan]

Aşağıdaki linkleri inceleyin.
http://www.excel.web.tr/f48/acyklamaya-otomatik-olarak-resim-eklemek-t132027.html
http://www.excel.web.tr/f48/hucre-acyklamasyna-resim-ekleme-t66978.html

 

[tahsinanarat]

Sn. serkanholep sayfanız korumalı olduğundan boş bir sayfada denedim aşağıdaki kodları sayfanın kod bölümüne yazarak kendinize göre uyarlayıp, dosyanında resimlerin bulunduğu aynı dizine kaydederek deneyiniz

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Columns("d").ClearComments
If Intersect(Target, [c6:d4500]) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
dosyaadi = ThisWorkbook.Path & "\ABC\" & Target.Value & ".jpg"
With Cells(Target.Row, "d")
.AddComment
.Comment.Visible = True
.Comment.Shape.Select True
If CreateObject("Scripting.FileSystemObject").FileExists(dosyaadi) = True Then
Selection.ShapeRange.Fill.UserPicture dosyaadi
Selection.Height = 250 'yukseklik
Selection.Width = 200 'genişlik
Target.Select
Else
.Comment.Visible = False
End If
End With
End Sub