Keresés

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

  • Delila_1

    veterán

    válasz Silious #50625 üzenetére

    Indítás előtt érdemes kitörölni az eddig bevitt képeket: Ctrl + g-re előjön az Ugrás menü, Irányított, Objektumok. Ez kijelöli az összes képet, Delete.
    Modulba tedd az alábbi makrót, ami az összes, A oszlopban szereplő képnév mellé beteszi a képet a C oszlopba..

    Sub Kepbeszuras()
    Dim utvonal As String, kep As String, sor As Long, usor As Long

    usor = Range("A" & Rows.Count).End(xlUp).Row
    utvonal = "D:\Jpg\" ' itt add meg a saját útvonaladat

    For sor = 1 To usor
    kep = utvonal & Cells(sor, 1) & ".jpg"
    Cells(sor, 3).Select
    On Error Resume Next
    ActiveSheet.Pictures.Insert(kep).Select
    Selection.Left = Cells(sor, 3).Left + 5
    Selection.Top = Cells(sor, 3).Top + 5
    Selection.Width = 40 'a kép szélessége
    Selection.Height = 30 'a kép magassága
    On Error GoTo 0
    Next
    End Sub

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