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

• #34876 Delila_1 veterán Traxx #34875

  Új Válasz 2017-04-11 12:28:41 #34876

  Ú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 Traxx #34875 üzenetére

  Túl hosszú ahhoz, hogy végignézzem.
  A kérdés felvetésekor összedobtam egy makrót, ez célratörőbbnek tűnik.

  A makróban a B2 cella bal felső széléhez illesztem az új logót. Csillagokkal jeleztem, melyik sorokban kell a kódot a saját adataidhoz igazítani.

  Sub Kepcsere()
Dim utvonal As String, FN, lap As Integer

Application.DisplayAlerts = False
utvonal = "C:\Tmp\" 'Excel fájlok útvonala *********
ChDir utvonal
FN = Dir(utvonal & "*.xls*")

Do While FN <> ""
Workbooks.Open utvonal & FN

For lap = 1 To Worksheets.Count
Sheets(lap).Select

ActiveSheet.DrawingObjects.Delete
Range("B2").Select 'Melyik cellához igazítsa a logót ***********
ActiveSheet.Pictures.Insert("D:\Logó_útvonala\Logo.jpg").Select 'Ezt is írd át *********
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 141.75 'Logó magassága '*******
Selection.ShapeRange.Width = 119.25 'Logó szélessége '*******
Next

ActiveWindow.Save
ActiveWindow.Close
FN = Dir()
Loop

Application.DisplayAlerts = True
End Sub

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