Sayfalar arası resim çağırma

[Argornst]

Merhabalar;

Sayfa 1 de tıkladığım hücreye göre (Aynı sütundaki) resim getirmesini istiyorum. Mevcut durumda elimde bir kod var ancak bu kod klasörden getiriyor ama benim istediğim bu değil. Bütün resimleri başka bir sayfaya koysam oradan kritere göre çağırma şansım var mı?

'''''Modül içerisine yazılacak kod'''''''''''''''''''''''''''''''''''''''''''''
Global yol As String
Sub resim_degistir()
    On Error Resume Next
 strPic = "Resim 2"
    Set shp = ActiveSheet.Shapes(strPic)
    With shp
        t = .Top
        l = .Left
        h = .Height
        w = .Width
    End With
    If yol = "" Then Exit Sub
    ActiveSheet.Shapes(strPic).Delete
    Set shp = ActiveSheet.Shapes.AddPicture(yol, msoFalse, msoTrue, l, t, w, h)
    shp.Name = strPic
End Sub

''''Sayfa içerisine yazılacak kod'''
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Dim satir As Long
If Not Intersect(Target, Range("A1:A60000")) Is Nothing Then
    satir = Target.Row
    yol = Range("B" & satir).Value
    resim_degistir
End If
End Sub

 

[Argornst]

Ambalaj sayfasındaki Malzeme adlarına tıkladığımda ilgili hücrenin resmi gelmesini istiyorum. Ama her resim için farklı pencere gelmeyecek tek pencerede gösterecek hangisini tıklarsam o resim gelsin. Üstteki kod ile bunu yapabiliyorum ancak onda resimleri klasörden çekiyor benim istediğim bunu resimlerin olduğu sayfadan çeksin. Bu koda revize yapıp istediğim şeyi yapabilir miyim? https://we.tl/t-eDeT2IdACW

 

[Argornst]

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A2:A1000")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target <> "" Then
        Dim Resim, adress, ResimAdi
        On Error Resume Next
        For Each Resim In ActiveSheet.Shapes
            adress = Resim.TopLeftCell.Row
            If Target.Row = adress Then
                Resim.Delete
                Exit For
            End If
    
        Next
        For Each Resim In Sheets("Resim").Shapes
            adress = Resim.TopLeftCell.Column
            If adress = 2 Then
                ResimAdi = Sheets("Resim").Cells(Resim.TopLeftCell.Row, 1).Value
                If ResimAdi = Target Then
                    Resim.Copy
                    ActiveSheet.Paste Destination:=Cells(Target.Row, 2)
                    With Cells(Target.Row, 2)
                        Selection.ShapeRange.LockAspectRatio = msoFalse
                        Selection.Height = .MergeArea.Height - 4
                        Selection.Width = .MergeArea.Width - 4
                        Selection.Top = .Top + 2
                        Selection.Left = .Left + 2
                        Selection.Placement = xlMoveAndSize
                    End With
                    Target.Select
                    Exit Sub
                End If
            End If
        Next
    End If

End Sub

@EmrExcel16 hocamın paylaştığı bu kodu buldum ancak kendi excel dosyama uygulayamadım. bu konuda yardımcı olabilir misiniz?

 

[Orion1]

Sayfa2de resimler var.sayfa2de resmim yanındaki sarı hücreye tıklayınız.
Örnek dosya ektedir. Ad tanımlaması ve makro kullanılarak yapılmışdır.

RESİM DOSYASI TIKLAYINIZ.

 

[Argornst]

Sayfa2de resimler var.sayfa2de resmim yanındaki sarı hücreye tıklayınız.
Örnek dosya ektedir.

RESİM DOSYASI

İlginiz için teşekkür ederim hocam ancak altın üyeliğim olmadığı için indiremiyorum

 

[Orion1]

İlginiz için teşekkür ederim hocam ancak altın üyeliğim olmadığı için indiremiyorum

Şimdi link ekledim.

 

[Argornst]

Şimdi link ekledim.

Hocam inceledim ancak benim istediğim bu şekilde değil. Bu videodaki işlemin aynısını yapmak istiyorum ama klasörden değilde diğer sayfadan çeksin istiyorum. Yine de teşekkür ederim

 

[Argornst]

Şimdi link ekledim.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
Range("C1").Value = Target.Row - 1
End Sub

Hocam bu kodda C1 i Resimler sayfasındaki C1 e nasıl yazdırırım. Mazur görün VBA kodlamada çok acemiyim yeni başladım.

 

[Orion1]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
Range("C1").Value = Target.Row - 1
End Sub

Hocam bu kodda C1 i Resimler sayfasındaki C1 e nasıl yazdırırım. Mazur görün VBA kodlamada çok acemiyim yeni başladım.

bu kodları resimler sayfasının modülüne yapıştırınız.

 

[Argornst]

bu kodları resimler sayfasının modülüne yapıştırınız.

Ama hocam benim benim seçilecek olacak olan hücrem Resimler sayfasında değil ben ambalaj sayfasında B sütununda herhangi bir hücreye tıkladığımda o hücreye karşılık gelen resim gelsin istiyorum.

 

[Orion1]

Ama hocam benim benim seçilecek olacak olan hücrem Resimler sayfasında değil ben ambalaj sayfasında B sütununda herhangi bir hücreye tıkladığımda o hücreye karşılık gelen resim gelsin istiyorum.

Bu böyle uzar gider.
Küçük bir örnek dosya ekleyip yollarsanız bakarım.

 

[Argornst]

yeni link hocam. Ambalaj sayfasındaki sağdaki boşluğa gelsin istiyorum resim @Orion1

 

[Orion1]

Dosya Linkte hocam. Ambalaj sayfasındaki sağdaki boşluğa gelsin istiyorum resim

başka linkten ekleyin.bu kayıt falan istiyor.

 

[Argornst]

başka linkten ekleyin.bu kayıt falan istiyor.

linki ekledim https://s7.dosya.tc/server16/8axjtx/AmbalajPalet.rar.html

 

[Orion1]

Oda dosya yükleme istiyor.
Aşağıdaki linke ekleyin.
DOSYA YÜKLE

 

[Argornst]

Oda dosya yükleme istiyor.
Aşağıdaki linke ekleyin.
DOSYA YÜKLE

https://dosya.co/n1huw0172s62/AmbalajPalet.rar.html Sizin de zamanınızı alıyorum kusura bakmayın gerçekten

 

[Orion1]

Listboxtan seçim yaparak resimler sipariş sayfasına gönderiliyor.

İndir Ambalaj Palet

Dosyayı indir Ambalaj Palet

dosya.co

 

[Argornst]

Listboxtan seçim yaparak resimler sipariş sayfasına gönderiliyor.
DOSYAYI INDIR

Çok teşekkür ederim ellerinize sağlık. Link boş ama hocam

 

[Orion1]

Çok teşekkür ederim ellerinize sağlık. Link boş ama hocam

17nci tagtan indirebilrisiniz.

 

[Argornst]

17nci tagtan indirebilrisiniz.

Elinize sağlık hocam tekrar teşekkür ederim