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
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Deneyiniz.:cool:

Kod:
goster = ThisWorkbook.Path & "\yeni\" & Dosya.Name
 
Katılım
9 Ocak 2008
Mesajlar
133
Excel Vers. ve Dili
office xp
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
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
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:
 
Katılım
9 Ocak 2008
Mesajlar
133
Excel Vers. ve Dili
office xp
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:

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
excel dosyanızı ve resimleri klasörü ile birlikte sıkıştırıp yollayınız.
 
Katılım
9 Ocak 2008
Mesajlar
133
Excel Vers. ve Dili
office xp
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
 
Katılım
9 Ocak 2008
Mesajlar
133
Excel Vers. ve Dili
office xp
Düzeldi teşekkürler
 
Üst