Hirdetés

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

  • Fferi50

    Topikgazda

    válasz bucihost #42199 üzenetére

    Szia!
    Sajnos MS úgy intézte, hogy a felvett makró ne legyen az igazi. :( Ma már másként kell a képeket beilleszteni...
    Ezt ókumuláltuk ki Delilával:
    Sub PlacePics()
        Dim Path As String, Pics As Range, Pic As Range, pc As Object
        On Error Resume Next
        Path = "C:\Users\branyiczkif\Desktop\AjanlatKepek\kepek\"
        Set Pics = ActiveSheet.Range("B2:B20")
        For Each Pic In Pics
            Pic.Offset(0, -1).Select
            ActiveSheet.Shapes.AddPicture Filename:=Path & Pic.Value & ".png", linktofile:=msoFalse, saveWithdocument:=msoTrue, Left:=Pic.Offset(0, -1).Left, Top:=Pic.Top, Width:=50, Height:=60
            If Pic.Value = "" Or Err <> 0 Then
                Pic.Offset(0, -1).Value = "X"
                Pic.Offset(0, -1).Font.ColorIndex = 3
            Else
                Pic.RowHeight = 60
            End If
        Next
        Cells(1).Select
    End Sub

    Üdv.

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