Soru Listbox'taki seçime göre resim

[seckinb]

Merhaba

Listbox'ta 8 seçeneğim bulunmakta.
Bu seçim ile "kimlik" sayfasındaki "I9" hücresinde bir değişikliğine neden olmakta.

Gerek listbox değeri, gerekse de I9 hücresinin değeri baz alınarak
aşağıdaki resimlerden uyumlu olanının
I33'de belirmesini (J38'e kadar) istiyorum.

bunu nasıl ayarlayabilirim?

 

[tamer42]

Merhaba

Listbox'ta 8 seçeneğim bulunmakta.
Bu seçim ile "kimlik" sayfasındaki "I9" hücresinde bir değişikliğine neden olmakta.

Gerek listbox değeri, gerekse de I9 hücresinin değeri baz alınarak
aşağıdaki resimlerden uyumlu olanının
I33'de belirmesini (J38'e kadar) istiyorum.

bunu nasıl ayarlayabilirim?

Merhaba,
Sorunuz tam anlaşılmıyor,
Buradaki uygun olan görseli sayfada bir yere mi kopyalamak istiyorsunuz?

Daha açıklayıcı yazarsanız, yardımcı olmaya çalışırız.

 

[seckinb]

listedeki yazılar ile resimler ilişkili.
amacım seçtiğim resmin kimlik sayfasında belirlediğim yerde görünmesi.

örneğin N1 seçtiğimde bu resim
I33 hücresinde belirecek.

 

[tamer42]

listedeki yazılar ile resimler ilişkili.
amacım seçtiğim resmin kimlik sayfasında belirlediğim yerde görünmesi.

örneğin N1 seçtiğimde bu resim
I33 hücresinde belirecek.

Ekli dosyayı görüntüle 218085

Öncelikle bu resimlerin her birini ayrı olarak bir klasör içinde saklamanız gerekecektir.

bu görselleri, Excel dosyasının bulunduğu klasör içine Resim adında bir klasör açarak, resim dosyalarını Liste kutusunda yazan şekliyle isimlendirmeniz gerekecek.

sonra Hikaye adındaki Form içerisine aşağıdaki kodları yazın

Private Sub LB5_Change()

Sheets("Kimlik").Range("I9") = LB5.Value

Dim ad As String
Dim ResimYolu As String
Dim Resim As Object
Dim Foto As Object

Dim ResimAlani As Range

Set ResimAlani = Sheets("Kimlik").Range("I33")

On Error Resume Next
Application.ScreenUpdating = False
For Each Foto In ActiveSheet.Pictures
    If Not Intersect(Foto.TopLeftCell, ResimAlani) Is Nothing Then
        Foto.Delete
    End If
Next

Set ResimAlani = Nothing

ad = LB5.Value

ResimYolu = ActiveWorkbook.Path & "\Resim\" & ad & ".png"

ResimEkle (ResimYolu)

    
End Sub

Sub ResimEkle(dosya As String)

If Dir(dosya) = "" Then Exit Sub

With Sheets("Kimlik").Pictures.Insert(dosya)
.Left = Cells(33, 9).Left
.Top = Cells(33, 9).Top
.ShapeRange.LockAspectRatio = True

End With

End Sub

 

[seckinb]

resim dosyalarının adresini değiştirmem gerekiyor.

bana uygun olan 2 üst

ResimYolu = ActiveWorkbook.Path & "\Resim\" & ad & ".png"

adresinden ziyade,

2üst klasörde (parent), kodlar klasörü.

 

[tamer42]

resim dosyalarının adresini değiştirmem gerekiyor.

bana uygun olan 2 üst

ResimYolu = ActiveWorkbook.Path & "\Resim\" & ad & ".png"

adresinden ziyade,

2üst klasörde (parent), kodlar klasörü.

ActiveWorkbook.Path & "\Resim\" yerine ilgili klasörün adresini yazabilirsiniz.

 

[seckinb]

Resimleri bu şekilde tek tek ayırıp adlandırdım. uzantıyı png olarak ayarladım.

Parent klasör olması sabit bir yer tanımlayacağım için önemli.

relat

 

[seckinb]

TRT\LU177_TATE\0555_İCLAL_***_SS\

klasörünün içerisinde excel dosyam bulunuyor.

resimleri
TRT\kodlar

klasöründe saklamak istiyorum

nasıl yapabilirim?

 

[tamer42]

TRT\LU177_TATE\0555_İCLAL_***_SS\

klasörünün içerisinde excel dosyam bulunuyor.

resimleri
TRT\kodlar

klasöründe saklamak istiyorum

nasıl yapabilirim?

Bir klasörde excel olması önemli değil,

"TRT\LU177_TATE\0555_İCLAL_***_SS\" bunun öncesinde sürücü adını belirtilen ifadeler olmalı

C:\Users\................\TRT\LU177_TATE\0555_İCLAL_***_SS\ gibi...

Resim üzerine sağ tıklayın özelliklerden Konum bilgisini kopyalayın buraya

ResimYolu = "C:\Users\..................\TRT\LU177_TATE\0555_İCLAL_***_SS\" & ad & ".png"

 

[seckinb]

Değişken olarak tanımlamam gerekiyor. dosyayı 5-6 farklı bilgisayarda kullanıyorum. hepsinde TRT klasörünün içinde ama önceki kısım değişiyor.

Parent\parent\excel.file
Parent\kodlar

şeklinde tanımlamam gerekiyor. Rölatif tanımlamakta zorlanıyorum.

 

[tamer42]

Değişken olarak tanımlamam gerekiyor. dosyayı 5-6 farklı bilgisayarda kullanıyorum. hepsinde TRT klasörünün içinde ama önceki kısım değişiyor.

Parent\parent\excel.file
Parent\kodlar

şeklinde tanımlamam gerekiyor. Rölatif tanımlamakta zorlanıyorum.

ActiveWorkbook.Path & "\...........\" dememizdeki amaç oydu zaten, hangi bilgisayarda çalışırsa çalışsın Excel' in bulunduğu klasörü referans alıyordu, siz de resimleri excel ile aynı klasöre ekleyin, çok mu zor bu işlemi yapmak....

 

[seckinb]

çok afedersiniz. karıştırdım sanırım

 

[seckinb]

dosya

 

[seckinb]

Resim adresi şu şekilde

Sub GetParent()
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
MsgBox oFSO.GetFile(ActiveWorkbook.FullName).ParentFolder.ParentFolder.ParentFolder.path & "\kodlar\"
End Sub

 

[tamer42]

Resim adresi şu şekilde

Sub GetParent()
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
MsgBox oFSO.GetFile(ActiveWorkbook.FullName).ParentFolder.ParentFolder.ParentFolder.path & "\kodlar\"
End Sub

bu şekilde deneyebilirsiniz.

Sub GetParent()
Dim ph As String
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
ph = oFSO.GetFile(ActiveWorkbook.FullName).ParentFolder.ParentFolder.ParentFolder.Path & "\kodlar\"

ResimYolu = ph & ad & ".png"

End Sub