Hirdetés

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

  • Delila_1

    Topikgazda

    válasz bucihost #42170 üzenetére

    Másik megoldás, hogy a "nagy piros x kép" ne növelje a fájl méretét.
    A két, csillagokkal jelölt sor a kép méretét határozza meg. A 0.4-et írd át kedved szerint. Ki is hagyható ez a két sor.

    Sub PlacePics()
        Dim Path As String, Pics As Range, Pic As Range
        
      Path = "C:\Users\branyiczkif\Desktop\AjanlatKepek\kepek\"
      Set Pics = ActiveSheet.Range("B2:B20")
        
        For Each Pic In Pics
            Pic.Offset(0, -1).Select
            On Error Resume Next
          ActiveSheet.Pictures.Insert(Path & Pic.Value & ".png").Select
            Selection.ShapeRange.ScaleWidth 0.4, msoFalse, msoScaleFromTopLeft  '***
            Selection.ShapeRange.ScaleHeight 0.4, msoFalse, msoScaleFromTopLeft  '***
            If VarType(Selection.ShapeRange) = vbError Then
                Pic.Offset(0, -1).Value = "X"
                Pic.Offset(0, -1).Font.ColorIndex = 3
                On Error GoTo 0
            End If
        Next Pic
    End Sub

    [ Szerkesztve ]

    Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

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