Diğer sayfalardaki listeden resimli ve sayısal veri çekmek?

[xgenc]

Selamlar Excel.web ailesi, bi konu hakkında yardımınızı rica edeceğim
Ekteki dosyada örnek liste var.
100 kalem ürün üzerinden sürekli liste çıkartıyrm ,

Basitçe, Analiste'ye barkod numarasını yazdığım ürünün resmi ve adı gelsin istiyorum.

Youtubeden ve forumda benzer veriler var ama tam olarka istediğimi yapamadım.
Şöyle de bi problem var.
Liste sayfarında benzer ürünler olabilir eğer varsa bile ilk okuduğu ürünün adını ve resmini getirmesini istiyorum.

Yardımı dokunacak herkese şimdiden teşekkürler.

 

[xgenc]

yardımcı olabilecek varmı acaba.?

 

[xgenc]

Merhaba yardımcı olabilecek varmı?

 

[Merhum İdris SERDAR]

.

Öyle anlaşılıyor ki; dosyada oldukça resim olacak. Bu kullanışlı bir şey olmayacaktır.

Ekte verdiğim örneği inceleyin.

.

 

[xgenc]

.

Öyle anlaşılıyor ki; dosyada oldukça resim olacak. Bu kullanışlı bir şey olmayacaktır.

Ekte verdiğim örneği inceleyin.

.

çok teşekkürler idris bey , olayın mantığına değinmişsiniz sanırım, örnek listemde işlem yapsaydınız keşke daha kolay anlardım,
bunu benim yapmak istediğim şekle getirmem zor olacak,

 

[YUSUF44]

İdris Bey'in söylemek istediği dosyanızın mevcut durumuyla kullanılmasının mantıklı ve kullanışlı olmadığıdır. Bir dosya içinde belki yüzlerce belki binlerce resim dosyası olması, bunların bazılarının mükerrer olması excel mantığına uygun değildir. Bunun yerine tıpkı İdris Bey'in paylaştığı örnekte olduğu gibi resim dosyalarının ayrı bir yerde bulunması ve dosyaya bu resimlerin çağrılması daha uygun olacaktır.

 

[xgenc]

Yusuf bey gayet net anladım sizi teşekkürler dediğiniz gibi benim mantık hatalı oldu,
örnek dosyayı güncelledim,
liste sayfasındaki resim ,ürün adı,barkod,fiyat bilgisi;
Ana - liste sayfasında barkodu yadığım zaman gelsin istiyorum,

Şimdi oldu sanırım?

 

[xgenc]

Örnek listemi inceleyen oldumu ?

 

[usubaykan]

Kullanılan kod;

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Resim As OLEObject, Yeni_Resim As OLEObject, Resim_Adres As Range, Yol As String, Resim_Adı As String
    
    If Intersect(Target, [D:D]) Is Nothing Then Exit Sub
    If Target = "" Then Exit Sub

    Application.ScreenUpdating = False
    
    Yol = ThisWorkbook.Path & "\STOKLAR\"
    Resim_Adı = Target.Value & ".jpg"

    Set Resim_Adres = Range(Target.Offset(0, -2).Address, Target.Offset(0, -2).Address)
    If ActiveSheet.Shapes.Count > 0 Then
        For Each Resim In ActiveSheet.OLEObjects
            If Not Intersect(Range(Resim.TopLeftCell.Address & ":" & Resim.TopLeftCell.Address), Resim_Adres) Is Nothing Then
                Resim.Delete
            End If
        Next
    End If
    
    Set Yeni_Resim = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
        DisplayAsIcon:=False, Left:=Resim_Adres.Left, Top:=Resim_Adres.Top, Width:=Resim_Adres.Width, Height:=Resim_Adres.Height)
    
    With Yeni_Resim
        .Top = Resim_Adres.Top
        .Left = Resim_Adres.Left
        .Height = Resim_Adres.Height
        .Width = Resim_Adres.Width
        .Object.PictureSizeMode = fmPictureSizeModeStretch
    End With
    
    If Dir(Yol & Resim_Adı) <> "" Then
        Yeni_Resim.Object.Picture = LoadPicture(Yol & Resim_Adı)
    Else
        Yeni_Resim.Object.Picture = LoadPicture(Yol & "X.jpg")
    End If
    
    Application.ScreenUpdating = True
End Sub

Alternatif bir çalışmadır.

Stoklar adlı bir klasör oluşturup ilgili resimleri .JPG formatında yine stoklar adlı klasörün altına getirmek istediğiniz barkod numarası ile kayıt etmeniz gerekmektedir. Eki inceleyiniz.

 

[xgenc]

Çok teşekkür ederim emeğinize sağlık, barkodu yazınca resim geliyor, peki ürün adınında gelmesi için ne yapmamız gerek? sadece ürün ve barkod isimlerinin olduğu bir dosya oluştursam?

şuan incelerken farkettim,
#barkodu sildiğimde soldaki resim silinmiyor kalıyor. http://prntscr.com/sp9nhw
# resimlerde bir işlem yapılmıyor büyültüp küçültemiyoruz mesela ,

teşeküürler.

 

[usubaykan]

bir sayfa ekleyin ve liste1 sayfanızın "C3" hücresinden başlayarak aşağıya doğru

=DÜŞEYARA(D3;Ürün_İsimleri!A:B;2;0)

formülünü uygulayın.

 

[xgenc]

bir sayfa ekleyin ve liste1 sayfanızın "C3" hücresinden başlayarak aşağıya doğru

=DÜŞEYARA(D3;Ürün_İsimleri!A:B;2;0)

formülünü uygulayın.

çok teşekkürler üstadım, diğer soruna baka bildinizmi?

şuan incelerken farkettim,
#barkodu sildiğimde soldaki resim silinmiyor kalıyor. http://prntscr.com/sp9nhw
# resimlerde bir işlem yapılmıyor büyültüp küçültemiyoruz mesela ,

teşeküürler.

 

[usubaykan]

çok teşekkürler üstadım, diğer soruna baka bildinizmi?

şuan incelerken farkettim,
#barkodu sildiğimde soldaki resim silinmiyor kalıyor. http://prntscr.com/sp9nhw
# resimlerde bir işlem yapılmıyor büyültüp küçültemiyoruz mesela ,

teşeküürler.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Resim As OLEObject, Yeni_Resim As OLEObject, Resim_Adres As Range, Yol As String, Resim_Adı As String
    
    If Intersect(Target, [D:D]) Is Nothing Then Exit Sub

    Application.ScreenUpdating = False
    
    Yol = ThisWorkbook.Path & "\STOKLAR\"
    Resim_Adı = Target.Value & ".jpg"

    Set Resim_Adres = Range(Target.Offset(0, -2).Address, Target.Offset(0, -2).Address)
    If ActiveSheet.Shapes.Count > 0 Then
        
    If Target = "" Then
        For Each Resim In ActiveSheet.OLEObjects
            If Not Intersect(Range(Resim.TopLeftCell.Address & ":" & Resim.TopLeftCell.Address), Resim_Adres) Is Nothing Then
                Resim.Delete
            End If
        Next
    Exit Sub
    End If
    End If
    
    Set Yeni_Resim = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
        DisplayAsIcon:=False, Left:=Resim_Adres.Left, Top:=Resim_Adres.Top, Width:=Resim_Adres.Width, Height:=Resim_Adres.Height)
    
    With Yeni_Resim
        .Top = Resim_Adres.Top
        .Left = Resim_Adres.Left
        .Height = Resim_Adres.Height
        .Width = Resim_Adres.Width
        .Object.PictureSizeMode = fmPictureSizeModeStretch
    End With
    
    If Dir(Yol & Resim_Adı) <> "" Then
        Yeni_Resim.Object.Picture = LoadPicture(Yol & Resim_Adı)
    Else
        Yeni_Resim.Object.Picture = LoadPicture(Yol & "X.jpg")
    End If
    
    Application.ScreenUpdating = True
End Sub

bu şekilde deneyin. Resim büyütüp küçültmek içinde hücre aralığını genişletmeniz yeterli
şekil 1