5
\$\begingroup\$

As I am a novice, I was keen to solve the task, so now I want to optimize the code.

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 Function

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", vbTextCompare) > 1 _
            Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) > 1 _
            Or InStr(1, strCompFilePath, "png", vbTextCompare) > 1) Then
    RowI = 29
    ColumnI = ColumnI + 1
    Set rgTarget = Cells(RowI, ColumnI)
    Application.ActiveSheet.Shapes.AddPicture strCompFilePath, False, True, rgTarget.Left, rgTarget.Top, 875, 400
    ColumnI = ColumnI + 17
    End If

End If
Next
End Sub
\$\endgroup\$
4
\$\begingroup\$

I will summarize what I said before (and add a few new ones):

  • 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.

\$\endgroup\$
  • \$\begingroup\$ Thank you for your detailed help to understand and improve the code i have tried to consider all the points and i have used the method shapes.Addpicture instead of .Insert \$\endgroup\$ – sandeep Jun 3 '16 at 11:19
4
\$\begingroup\$

Be sure to avoid things like .Activate - it just slows the code down by needing to fiddle with the spreadsheet while doing everything else behind the scenes. There's a good question on Stack Overflow addressing this.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.