İyi Haftasonları;
Aşağıdaki kodla, farklı bir tabloda Userform1:image'ye A klasörün içindeki "Resimler" klasöründen Liste kitabın Liste sayfasında bulunan C sutunundaki hücreye çift tıkladığımda nosuna ait resim gelmekte, ancak aynı mantıkla yaptığım yeni uıygulamada resimler gelmemektedir.
Sorun nereden kaynaklanmakta olup Çözümü nedir.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
'resim getirme
Dim evn As Object, Resim As Object, Bak As Object
Unload UserForm1
Select Case Target.Column
Case Is = 3
If Target.Row > 3 And Target.Row <= 65536 And Target.Value <> "" Then
Set evn = CreateObject("scripting.filesystemobject")
Set Resim = evn.GetFolder(ThisWorkbook.Path & "\Resimler\")
Set col = New Collection
For Each Bak In Resim.Files
If Bak.Name Like Target.Value & "*" Then
col.Add ThisWorkbook.Path & "\Resimler\" & Bak.Name
End If
Next Bak
UserForm1.Show 0
End If
Set evn = Nothing: Set Resim = Nothing: Set Bak = Nothing
If UserForm1.Image1.Picture = LoadPicture("") Then
Unload UserForm1
End If
End Select
sat = ActiveCell.Row
UserForm1.Caption = Cells(sat, 3).Value & " " & Cells(sat, 5).Value
UserForm1.Label1.Caption = Cells(sat, 3).Value & " " & Cells(sat, 5).Value & " " & "İlçesi " & Cells(sat, 7).Value & " ada" & " " & Cells(sat, 8).Value & " parsel"
End Sub
Aşağıdaki kodla, farklı bir tabloda Userform1:image'ye A klasörün içindeki "Resimler" klasöründen Liste kitabın Liste sayfasında bulunan C sutunundaki hücreye çift tıkladığımda nosuna ait resim gelmekte, ancak aynı mantıkla yaptığım yeni uıygulamada resimler gelmemektedir.
Sorun nereden kaynaklanmakta olup Çözümü nedir.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
'resim getirme
Dim evn As Object, Resim As Object, Bak As Object
Unload UserForm1
Select Case Target.Column
Case Is = 3
If Target.Row > 3 And Target.Row <= 65536 And Target.Value <> "" Then
Set evn = CreateObject("scripting.filesystemobject")
Set Resim = evn.GetFolder(ThisWorkbook.Path & "\Resimler\")
Set col = New Collection
For Each Bak In Resim.Files
If Bak.Name Like Target.Value & "*" Then
col.Add ThisWorkbook.Path & "\Resimler\" & Bak.Name
End If
Next Bak
UserForm1.Show 0
End If
Set evn = Nothing: Set Resim = Nothing: Set Bak = Nothing
If UserForm1.Image1.Picture = LoadPicture("") Then
Unload UserForm1
End If
End Select
sat = ActiveCell.Row
UserForm1.Caption = Cells(sat, 3).Value & " " & Cells(sat, 5).Value
UserForm1.Label1.Caption = Cells(sat, 3).Value & " " & Cells(sat, 5).Value & " " & "İlçesi " & Cells(sat, 7).Value & " ada" & " " & Cells(sat, 8).Value & " parsel"
End Sub
