Hi Mattrixdesign,
Add a new module into the workbook then paste the code below in this module:
Private Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type
Private Sub FindFiles()
'Modified code : Reference
http://www.vbapi.com
Dim hsearch As Long
Dim findinfo As WIN32_FIND_DATA
Dim success As Long
Dim buffer As String
Dim retval As Long
Dim fileinfo As String 'User defined
'I used gifs in windows directory
fileinfo = "C:Windows*.gif"
hsearch = FindFirstFile(fileinfo, findinfo)
If hsearch = -1 Then
Exit Sub
End If
Do
buffer = Left(findinfo.cFileName, InStr(findinfo.cFileName, vbNullChar) - 1)
ActiveSheet.Pictures.Insert("C:Windows" & buffer).Select
Selection.Left = 0
If ActiveSheet.Pictures.Count = 1 Then
Selection.Top = 0
Else
Selection.Top = ActiveSheet.Pictures(ActiveSheet.Pictures.Count - 1).Height + ActiveSheet.Pictures(ActiveSheet.Pictures.Count - 1).Top
End If
success = FindNextFile(hsearch, findinfo)
Loop Until success = 0
retval = FindClose(hsearch)
End Sub
Code locates pictures up to down in sheet. I dont know how you want to resize cells or all pictures are in same size? Please ask for more if you need.