Excel Import Photo Problem

[HEYSHUNT]

Hi All,

Im a newbie with VBA - just finding the code online i need for small projects. Ive found some code to import photos to a sheet based on cell values, but i need it to start inserting in to cell A2 not A10.

Also how can i get the photo to centre in the cell?

Any help is much appreciated.

Chris

Sub IMPORTPHOTOS()
    Dim mainWorkBook As Workbook
    Set mainWorkBook = ActiveWorkbook
    Sheets("QUOTESHEET").Activate
    Folderpath = "C:\PHOTOS"
    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("QUOTESHEET").Range("A1" & counter).Value = fls.Name
                  Sheets("QUOTESHEET").Range("A1" & counter).ColumnWidth = 12
                Sheets("QUOTESHEET").Range("B1" & counter).RowHeight = 76
                Sheets("QUOTESHEET").Range("B1" & counter).Activate
                Call insert(strCompFilePath, counter)
                Sheets("QUOTESHEET").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("A1" & counter).Left
        .Top = ActiveSheet.Range("A1" & counter).Top
        .Placement = 1
        .PrintObject = True
    End With
End Function

 

[Perpa]

Sub IMPORTPHOTOS()
Dim mainWorkBook As Workbook
Set mainWorkBook = ActiveWorkbook
Sheets("QUOTESHEET").Activate
Folderpath = "C:\PHOTOS"
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("QUOTESHEET").Range("A1" & counter).Value = fls.Name
Sheets("QUOTESHEET").Range("A1" & counter).ColumnWidth = 12
Sheets("QUOTESHEET").Range("B1" & counter).RowHeight = 76
Sheets("QUOTESHEET").Range("B1" & counter).Activate

Call insert(strCompFilePath, counter)

Sheets("QUOTESHEET").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("A1" & counter).Left
.Top = ActiveSheet.Range("A1" & counter).Top
.Placement = 1
.PrintObject = True
End With
End Function

Chris,
Welcome to the Forum.
The code you furnished is a bit confusing. Maybe you can explain what you are trying to accomplish and where the filename and the picture will be placed.

Your code is placing the filename 'fls' in column A. You set the cell column A Width to 12, and row Height of 76. Then in the Insert function you set the picture height = 70 and the top is tied to the top of the cell... It makes me wonder if you are trying to put the filename and the picture in the same cell in column A. What is confusing then is what you do with column B...you Activate the cell in column B before calling the Insert function, but then the Insert function adjusts the Left and Top of the picture to column A???

I do not see where your code is begining in cell A10, the counter begins with a value of 1 which would be A1. By the way, the 'Range("A1" & counter)' should be 'Range("A" & counter)'.

It is not clear what you are trying to do with column B?

Let's see how you respond to these comments/questions and then we can deal with centering the picture in column A or B, or over both columns.
Perpa