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

• #31003 Delila_1 veterán thomas50.000 #31002

  Új Válasz 2016-03-14 13:44:40 #31003

  Ú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 thomas50.000 #31002 üzenetére

  Megoldható, ha a jelzett cellák (B4:B23, L4:L23, AF4:AF23) a képek nevével azonosak, csak a kiterjesztést kell hozzájuk venni. Ezt kell átírnod a csillagozott sorokban, ha nem jpg a kiterjesztés, na meg az útvonalat.

  Sub Kepek()
  Dim Kepneve As String, utvonal As String, sor As Long
  
  utvonal = "D:\Mappa\Almappa\" '***
  
  For sor = 4 To 23
  Kepneve = Cells(sor, "B") & ".jpg" '*****
  With ActiveSheet.Pictures.Insert(utvonal & Kepneve)
  .Top = Rows(sor).Top
  .Height = Rows(sor).Height
  .Left = Columns(2).Left + Columns(2).Width - .Width
  End With
  
  Kepneve = Cells(sor, "L") & ".jpg" '*****
  With ActiveSheet.Pictures.Insert(utvonal & Kepneve)
  .Top = Rows(sor).Top
  .Height = Rows(sor).Height
  .Left = Columns(12).Left + Columns(12).Width - .Width
  End With
  
  Kepneve = Cells(sor, "AF") & ".jpg" '*****
  With ActiveSheet.Pictures.Insert(utvonal & Kepneve)
  .Top = Rows(sor).Top
  .Height = Rows(sor).Height
  .Left = Columns(32).Left + Columns(32).Width - .Width
  End With
  Next
  End Sub

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