Dennis_chnou Postad 23 november, 2016 Share Postad 23 november, 2016 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 WorkbookSet mainWorkBook = ActiveWorkbookSheets("Object").ActivateFolderpath = "C:\Users\Sumit Jain\Pictures"Set fso = CreateObject("Scripting.FileSystemObject")NoOfFiles = fso.GetFolder(Folderpath).Files.CountSet listfiles = fso.GetFolder(Folderpath).FilesFor Each fls In listfilesstrCompFilePath = Folderpath & "\" & Trim(fls.Name)If strCompFilePath <> "" ThenIf (InStr(1, strCompFilePath, "jpg", vbTextCompare) > 1 _Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) > 1 _Or InStr(1, strCompFilePath, "png", vbTextCompare) > 1) Thencounter = counter + 1Sheets("Object").Range("A" & counter).Value = fls.NameSheets("Object").Range("B" & counter).ColumnWidth = 25Sheets("Object").Range("B" & counter).RowHeight = 100Sheets("Object").Range("B" & counter).ActivateCall insert(strCompFilePath, counter)Sheets("Object").ActivateEnd IfEnd IfNextmainWorkBook.SaveEnd SubFunction insert(PicPath, counter)'MsgBox PicPathWith ActiveSheet.Pictures.insert(PicPath)With .ShapeRange.LockAspectRatio = msoTrue.Width = 50.Height = 70End With.Left = ActiveSheet.Range("B" & counter).Left.Top = ActiveSheet.Range("B" & counter).Top.Placement = 1.PrintObject = TrueEnd WithEnd 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 Länk till kommentar Dela på andra webbplatser More sharing options...
Rekommendera Poster
Arkiverat
Det här ämnet är nu arkiverat och är stängt för ytterligare svar.