Insert Macro Not Working in Excel 2010

[Sudarshan_1026]

Hi All,

I have a query on the same thread. I am using this macro below to paste pictures from a folder. This works perfect when run on excel 2007, however it only links image when this is run on excel 2010. Can you please help me tweak this to eliminate the error.

Option Explicit


Sub alex_it_saving_lives()


'get the image folder path
Dim strImagePath As String
strImagePath = GetImageFolderPath
If (Len(strImagePath) = 0) Then
Exit Sub
End If


'get all images in the image path
Dim vImageFiles As Variant
vImageFiles = findAllFiles(strImagePath)

'check there are files
If (UBound(vImageFiles, 1) = 0) Then
MsgBox "No jpg Files Exist In : " & strImagePath
Exit Sub
End If

'stop updating the screen
Application.ScreenUpdating = False

'clear any existing pictures from the sheet
Dim shp As Shape
For Each shp In ThisWorkbook.ActiveSheet.Shapes
If shp.Name Like "Picture*" Then
shp.Delete
End If
Next shp
'clear any test
ThisWorkbook.ActiveSheet.Cells.Clear

Dim strFile As String, rng As Range
'and so on
Dim myCol, myRow
myCol = 2 'first column for pasting picture
myRow = 2 'first row for pasting picture

Dim iImageCount As Integer
For iImageCount = 0 To UBound(vImageFiles, 1)

'read the file name
strFile = strImagePath & vImageFiles(iImageCount) 'ws.Range("A" & iImageCount)

'define where to put it
ThisWorkbook.ActiveSheet.Cells(myRow - 1, myCol).Value = vImageFiles(iImageCount)
Set rng = Range(ThisWorkbook.ActiveSheet.Cells(myRow, myCol), ThisWorkbook.ActiveSheet.Cells(myRow + 10, myCol + 3))

InsertPictureInRange strFile, rng

'figure out where the next picture goes
If myCol = 2 Then
'next picture is same row, column I = 9
myCol = 10
Else
'next picture is down 14 rows
myCol = 2
myRow = myRow + 17
'be sure we do not attempt to run off the page!
If myRow > ThisWorkbook.ActiveSheet.Rows.Count - 11 Then
MsgBox "Too many images for excel sheet! Some are not displayed"
Exit Sub
End If
End If
Next iImageCount

Application.ScreenUpdating = False

DisplayEndMessage

End Sub




Function GetImageFolderPath() As String


Dim strFolder As String
strFolder = InputBox("Enter the jpg image files path", "WARNING : This will clear any current data in the sheet!")
If (Len(strFolder) = 0) Then
MsgBox "No Folder Chosen! Cannot Continue"
Exit Function
End If
If (Right(strFolder, 1) <> "\" And Right(strFolder, 1) <> "/") Then
strFolder = strFolder & "\"
End If

GetImageFolderPath = strFolder

End Function


Function FileList(fldr As String, Optional fltr As String = "*.*") As Variant
Dim sTemp As String, sHldr As String
If Right$(fldr, 1) <> "\" Then fldr = fldr & "\"
sTemp = Dir(fldr & fltr)
If sTemp = "" Then
FileList = Split("No files found", "|") 'ensures an array is returned
Exit Function
End If
Do
sHldr = Dir
If sHldr = "" Then Exit Do
sTemp = sTemp & "|" & sHldr
Loop
FileList = Split(sTemp, "|")
End Function


Function findAllFiles(strImagePath As String)


Dim strFolder As String
strFolder = strImagePath
If (Right(strFolder, 1) <> "\" And Right(strFolder, 1) <> "/") Then
strFolder = strFolder & "\"
End If

'hard code the filter to be jpg files!
Dim strFilter As String
strFilter = "*.jpg"

Dim vFiles As Variant
vFiles = FileList(strFolder, strFilter)
findAllFiles = vFiles


End Function

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
p.ShapeRange.LockAspectRatio = False
' determine positions
With TargetCells
t = .Top
l = .Left
w = .Offset(0, .Columns.Count + 2).Left - .Left
h = .Offset(.Rows.Count + 4, 0).Top - .Top
End With
' position picture
With p
.Top = t
.Left = l
.Width = w
.Height = h
End With
Set p = Nothing
End Su

 

[patel45]

Your code works well on my Excel 2010

 

[Teeroy]

Have a look at VBA command changed in Excel 2010?; it might help you.

 

[Sudarshan_1026]

It does paste images however when i send the file across to some one who views this in 2007 he see an error " the linked image cannot be displayed"