Keresés

Új hozzászólás Aktív témák

  • Delila_1

    veterán

    válasz huan #49422 üzenetére

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim FN As Picture, CV As Range, ter As Range
        Dim KepHelye As String
        
        If Target.Column = 1 Then
            Application.EnableEvents = False
            If Target.Count > 1 Then
                Set ter = Range(Target.Address)
                For Each CV In ter
                    KepHelye = "D:\kepek\" & CV.Value & ".jpg"
                    With Cells(CV.Row, 2)
                        Set FN = ActiveSheet.Pictures.Insert(KepHelye)
                        .RowHeight = Rows(Target.Row).Height
                        FN.Top = .Top + 1
                        FN.Left = Columns(2).Left + 1
                        FN.Height = Rows(Target.Row).Height - 5
                        FN.Height = .Height
                        FN.Placement = xlMoveAndSize
                    End With
                Next
            End If
            Application.EnableEvents = True
        End If
    End Sub

Új hozzászólás Aktív témák

Hirdetés