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

Läsa in bilder i Excel

Rekommendera Poster

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

Redigerad av Dennis_chnou

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Jag förutsätter att du använder Firefox eller någon annan webblösare som blockerar skript. Annars förstör E-forums reklam-skript koden (jag glömde bort att det är så och fick en massa fel i din kod :-( )

 

Nåja. Det du vill göra är att använda Cells(radnummer, kolumnnummer) istället för Range

 

 

I den första "subben" byter du ut koden 

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

 

Mot 

 

Sheets("Object").Cells(1, counter).Value = fls.Name

Sheets("Object").Cells(2, counter).ColumnWidth = 25
Sheets("Object").Cells(2, counter).RowHeight = 100
Sheets("Object").Cells(2, counter).Activate
 
Och i funktionen ändrar du raderna
.Left = ActiveSheet.Range("B" & counter).Left
.Top = ActiveSheet.Range("B" & counter).Top
till
        .Left = ActiveSheet.Cells(2, counter).Left
        .Top = ActiveSheet.Cells(2, counter).Top

 

Det är för övrigt den här delen av koden som blir obegriplig i ditt inlägg om du kör "fel" webbläsare. 

 

 

Länk till olika sätt att referera till en cell:

https://msdn.microsoft.com/en-us/library/office/aa221357(v=office.11).aspx

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Skapa ett konto eller logga in för att kommentera

Du måste vara medlem för att kunna kommentera

Skapa ett konto

Skapa ett nytt konto på vårt forum. Det är lätt!

Registrera ett nytt konto

Logga in

Redan medlem? Logga in här.

Logga in nu



×
×
  • Skapa nytt...