Just nu i M3-nätverket
Jump to content

Läsa in bilder i Excel


Dennis_chnou
 Share

Recommended Posts

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

Edited by Dennis_chnou
Link to comment
Share on other sites

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

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share



×
×
  • Create New...