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

• #42172 Delila_1 veterán bucihost #42170

  Új Válasz 2019-11-13 07:41:46 #42172

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  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

• #42171 Fferi50 Topikgazda bucihost #42170

  Új Válasz 2019-11-13 07:35:47 #42171

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Fferi50

  Topikgazda

  válasz bucihost #42170 üzenetére

  Szia!
          Pic.Offset(0, -1).Select
        If Dir(Path & Pic.Value & ".png")="" Then
                 ActiveSheet.Pictures.Insert( nagy piros x kép neve).select
        Else
                 ActiveSheet.Pictures.Insert(Path & Pic.Value & ".png").Select
        End If
Üdv.

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