patternMinor
Importing JPG, JPEG, and PNG images from a folder to an Excel worksheet
Viewed 0 times
pngimagesexcelworksheetfolderjpgandimportingfromjpeg
Problem
As I am a novice, I was keen to solve the task, so now I want to optimize the code.
Based on Comments Optimized code
```
Sub AddImage2()
Dim rgTarget As Range
Dim RowI As Long, ColumnI As Long
Folderpath = "C:\Users\sandeep.hc\Pics"
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", vbTextCom
Sub AddOlEObject()
Dim mainWorkBook As Workbook
Set mainWorkBook = ActiveWorkbook
Sheets("SingleProfile").Activate
Folderpath = "C:\Users\sandeep.hc\Pics"
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 = 29
counter1 = counter1 + 1
Call insert(strCompFilePath, counter, counter1)
'Sheets("SingleProfile").Activate
counter1 = counter1 + 17
End If
End If
Next
mainWorkBook.Save
End Sub
Function insert(PicPath, counter, counter1)
'MsgBox PicPath
With ActiveSheet.Pictures.insert(PicPath)
With .ShapeRange
.LockAspectRatio = msoFalse
.Width = 875
.Height = 300
End With
.Left = ActiveSheet.Cells(counter, counter1).Left
.Top = ActiveSheet.Cells(counter, counter1).Top
.Placement = 1
.PrintObject = True
End With
End FunctionBased on Comments Optimized code
```
Sub AddImage2()
Dim rgTarget As Range
Dim RowI As Long, ColumnI As Long
Folderpath = "C:\Users\sandeep.hc\Pics"
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", vbTextCom
Solution
I will summarize what I said before (and add a few new ones):
-
Use
-
instead of
-
rename
-
Declare
-
instead of passing the row and column index to the
-
possibly rename
-
add the option
-
as it is now, you don't really need
-
instead of the FileSystemObject I would use
-
Use
Option Explicit at the top of your module. It helps you to prevent mistakes and forces you to declare the variables-
instead of
Instr use Right as in If Right(strCompFilePath,4)=".jpg" -
rename
counter and counter1 so it is clear what they are (row and column indices)-
Declare
insert as a Sub and not a Function.-
instead of passing the row and column index to the
insert function/sub and then using the ActiveSheet pass the cell as a Range to the insert function/sub. (Instead of Activesheet you can use cell.Worksheet to get the right sheet) -
possibly rename
insert so you don't confuse it with Pictures.insert-
add the option
savewithfile := true to the Pictures.Insert method so the pictures will stay in the file even if you send it somewhere.-
as it is now, you don't really need
NoOfFiles and mainWorkBook -
instead of the FileSystemObject I would use
Dir. See this for more on that.Context
StackExchange Code Review Q#129828, answer score: 4
Revisions (0)
No revisions yet.