Just nu i M3-nätverket
Gå till innehåll

Dennis_chnou

Medlem
  • Antal inlägg

    1
  • Gick med

  • Senaste besök

  1. Hej, Jag har använder denna kod: från http://excel-macro.tutorialhorizon.com/excel-vba-insert-multiple-images-from-a-folder-to-excel-cells/#pinglist-container Sub AddOlEObject() Dim mainWorkBook As Workbook Set mainWorkBook = ActiveWorkbook Sheets("Object").Activate Folderpath = "C:\Users\Sumit Jain\Pictures" Set fso = CreateObject("Scripting.FileSystemObject") NoOfFiles = fso.GetFolder(Folderpath).Files.Count Set listfiles = fso.GetFolder(Folderpath).Files For Each fls In listfiles strCompFilePath = Folderpath & "\" & Trim(fls.Name) If strCompFilePath <> "" Then If (InStr(1, strCompFilePath, "jpg", vbTextCompare) > 1 _ Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) > 1 _ Or InStr(1, strCompFilePath, "png", vbTextCompare) > 1) Then counter = counter + 1 Sheets("Object").Range("A" & counter).Value = fls.Name Sheets("Object").Range("B" & counter).ColumnWidth = 25 Sheets("Object").Range("B" & counter).RowHeight = 100 Sheets("Object").Range("B" & counter).Activate Call insert(strCompFilePath, counter) Sheets("Object").Activate End If End If Next mainWorkBook.Save End Sub Function insert(PicPath, counter) 'MsgBox PicPath With ActiveSheet.Pictures.insert(PicPath) With .ShapeRange .LockAspectRatio = msoTrue .Width = 50 .Height = 70 End With .Left = ActiveSheet.Range("B" & counter).Left .Top = ActiveSheet.Range("B" & counter).Top .Placement = 1 .PrintObject = True End With End Function från hemsidan, excel-macro för att läsa in bilder ur en mapp och föra in dom till ett excel dokument. Koden läser in filer i vertikal-led, men jag önskar att få in bilderna, horisontellt. Har försökt modifiera sista delen i koden (Function insert(PicPath, counter)) men får det inte att funka. Kan någon duktig person se hur man löser detta? Tack på förhand!! Mvh, Dennis Noubarpour
×
×
  • Skapa nytt...