• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

resim gösterimi

Katılım
9 Ocak 2008
Mesajlar
133
Excel Vers. ve Dili
office xp
If dosyaadi = Me.ComboBox1.Text Then
goster = ThisWorkbook.Path & "\" & Dosya.Name
Me.Image1.Picture = LoadPicture(goster)
Exit For
yukarıdaki modül ile resimlerim ve excel projem aynı klasörde oldugundan resimleri görebiliyorum ben klasörün içinde foto isimli yeni bir klasör oluşturup fotoğrafları bunun içine atsam
goster = ThisWorkbook.Path & "\" & Dosya.Name
Me.Image1.Picture = LoadPicture(goster)
burayı nasıl degiştirmeliyim Şimdiden teşekkürler
 
Deneyiniz.:cool:

Kod:
goster = ThisWorkbook.Path & "\yeni\" & Dosya.Name
 
Benmi yapamadım çalıştıramadım kodun tamamı aşagıdaki gibi kod ile resim gelmedi

Private Sub CommandButton2_Click()
Dim bul As Range
Dim evn As Object
Set evn = CreateObject("scripting.filesystemobject")
Set klasor = evn.GetFolder(ThisWorkbook.Path)
For Each bul In Sayfa1.Range("b2:b" & Range("b65536").End(3).Row)
If bul = ComboBox1 Then
bul.Offset(i, -1).Activate
TextBox1 = bul.Offset(i, 1)
TextBox2 = bul.Offset(i, 2)
TextBox3 = bul.Offset(i, -1)
For Each Dosya In klasor.Files
dosyaadi = Mid(Dosya.Name, 1, InStrRev(Dosya.Name, ".", -1, 1) - 1)
If dosyaadi = Me.ComboBox1.Text Then

goster = ThisWorkbook.Path & "\yeni\" & Dosya.Name

Me.Image1.Picture = LoadPicture(goster)
Exit For
End If
Next Dosya

Else
TextBox3 = Sayfa1.Range("a65536").End(3).Value + 1
End If
Next bul
End Sub
 
Excel dosyasının bulunduğu klasörün içinde bir alt klasör olmalı,klasörün adı yeni olmalı.resim dosyalarınızda bu, yeni adlı klasörün içinde olmalı.:cool:
 
Orion1 ilgine teşekkürler dediginin aynısını yaptım ama resimler gelmiyor(sadece resimler yeni adlı klasör içinde)proje masa üstündeki pers adlı klasörde
(pers klasöründe excel çalışması ve yeni isimli klasör bu klasörün içinde resimler var)
 
Son düzenleme:
excel dosyanızı ve resimleri klasörü ile birlikte sıkıştırıp yollayınız.
 
Orion1 dosyayı upload etmeyi yapamadım bu nedenle usrform1 deki kodların hepsi aşagıda yardımcı olursanız sevinirim

Private Sub ComboBox1_Change()
TextBox1 = epmpty: TextBox2 = Empty: TextBox3 = Empty
Image1.Picture = LoadPicture("")
Label5.Visible = False
End Sub

Private Sub CommandButton1_Click()
If TextBox1.Text <> Empty And TextBox2.Text <> Empty And ComboBox1.Text <> Empty Then
TextBox3 = Sayfa1.Range("a65536").End(3).Value + 1
Else
MsgBox "Eksik bilgi girilmiş", vbExclamation, "Www.ExcelVBA.Net"
CommandButton2_Click
Exit Sub
End If
With Sayfa1
For Each bul In Sayfa1.Range("b2:b" & Range("b65536").End(3).Row)
If bul = ComboBox1 Then
Label5.Visible = True
Exit Sub
End If
Next bul
For Each bul In .Range("b2:b" & Range("b65536").End(3).Row)
If bul = ComboBox1 Then
bul.Offset(i, -1).Activate
bul.Offset(i, 1) = TextBox1
bul.Offset(i, 2) = TextBox2
bul.Offset(i, -1) = TextBox3
Exit For
Else
.Range("a65536").End(3).Offset(1, 0) = .Range("a65536").End(3) + 1
.Range("a65536").End(3).Offset(0, 1) = ComboBox1
.Range("a65536").End(3).Offset(0, 2) = TextBox1
.Range("a65536").End(3).Offset(0, 3) = TextBox2
CommandButton2_Click
ComboBox1.Clear
UserForm_Initialize
Exit For
End If
Next bul
End With
End Sub

Private Sub CommandButton2_Click()
Dim bul As Range
Dim evn As Object
Set evn = CreateObject("scripting.filesystemobject")
Set klasor = evn.GetFolder(ThisWorkbook.Path)
For Each bul In Sayfa1.Range("b2:b" & Range("b65536").End(3).Row)
If bul = ComboBox1 Then
bul.Offset(i, -1).Activate
TextBox1 = bul.Offset(i, 1)
TextBox2 = bul.Offset(i, 2)
TextBox3 = bul.Offset(i, -1)
For Each Dosya In klasor.Files
dosyaadi = Mid(Dosya.Name, 1, InStrRev(Dosya.Name, ".", -1, 1) - 1)
If dosyaadi = Me.ComboBox1.Text Then
goster = ThisWorkbook.Path & "\yeni\" & Dosya.Name
Me.Image1.Picture = LoadPicture(goster)
Exit For
End If
Next Dosya

Else
TextBox3 = Sayfa1.Range("a65536").End(3).Value + 1
End If
Next bul
End Sub

Private Sub Image1_Click()

End Sub

Private Sub UserForm_Initialize()
Dim i As Byte
For i = 2 To [a65536].End(3).Row
ComboBox1.AddItem Cells(i, 2)
Next i
End Sub

Private Sub CommandButton3_Click()
Unload UserForm1
End Sub
 
Düzeldi teşekkürler
 
Geri
Üst