Diğer sayfadan resim çekme

Katılım
12 Şubat 2014
Mesajlar
201
Excel Vers. ve Dili
office2013
Altın Üyelik Bitiş Tarihi
15-12-2021
Merhaba,
Özet sayfasındaki sipariş kodunu yazdığımızda detay sayfasındaki o kodla eşleşen resmin F sütununa gelmesini istiyorum. Gelen resminde F sütununa tam sığmış olarak gelmesini istiyorum. Yardımı olabilirseniz sevinirim.
 

Ekli dosyalar

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Merhaba , deneyiniz..

JavaScript:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A8:A1000")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target <> "" Then
        Dim Resim, ResimAdi, Adress
        On Error Resume Next
        For Each Resim In ActiveSheet.Shapes
            Adress = Resim.TopLeftCell.Row
            If Target.Row = Adress Then
                Resim.ShapeRange.LockAspectRatio = msoFalse
                Resim.Delete
                Exit For
            End If
        Next
        For Each Resim In Sheets("detay").Shapes
            Adress = Resim.TopLeftCell.Column
            If Adress = 2 Then
                ResimAdi = Sheets("detay").Cells(Resim.TopLeftCell.Row, 1).Value
                If ResimAdi = Target Then
                    If Left(Resim.Name, 7) <> "Control" Then
                        Resim.Copy
                        ActiveSheet.Paste Destination:=Cells(Target.Row, 6)
                        With Cells(Target.Row, 6)
                            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
            End If
        Next
    End If
End Sub
 

Ekli dosyalar

Üst