YellowLabPro
10-04-2008, 12:25 PM
I have some code that goes out and gets jpg files and places them inside Excel. This can be a long list of files, and to make viewing more convenient, i.e. not having to scroll down or over, is there some code that will always reposition the image to the middle of the screen?
If so, I will need some assistance in the code.
Thanks,
Doug
Public Sub makeDogTrainingWorksheet()
Application.ScreenUpdating = False
Set oFSO = CreateObject("Scripting.FileSystemObject")
iCurrentRow = 1
'collectFiles "C:\Documents and Settings\Doug\Desktop\Converted Images" '_
collectFiles "C:\Documents and Settings\Doug\Desktop\Copy of Dog Stuff\Dog Training\Course Lessons\Unit 1\Lesson 1" _
, ActiveSheet _
, ".jpg" _
, 1
Application.ScreenUpdating = True
End Sub
Public Sub collectFiles(ByRef path As String, ByRef ws As Excel.Worksheet, _
ByRef fileType As String, ByVal iColumn As Long)
Dim Folder As Object
Dim file As Object
Dim fldr As Object
Dim blnMoveBackColumn As Boolean
Set Folder = oFSO.GetFolder(path)
ws.Cells(iCurrentRow, iColumn).Value = Folder.Name
iColumn = iColumn + 1
iCurrentRow = iCurrentRow + 1
For Each file In Folder.Files
If (LCase(Right(file, 4)) = LCase(fileType)) Then
With ws.Cells(iCurrentRow, iColumn)
.Value = file.Name
.AddComment.Shape.Fill.UserPicture file.path
.Comment.Shape.Width = 1100
.Comment.Shape.Height = 647
iCurrentRow = iCurrentRow + 1
End With
End If
Next file
For Each fldr In Folder.Subfolders
collectFiles fldr.path, ws, fileType, iColumn
Next fldr
End Sub
If so, I will need some assistance in the code.
Thanks,
Doug
Public Sub makeDogTrainingWorksheet()
Application.ScreenUpdating = False
Set oFSO = CreateObject("Scripting.FileSystemObject")
iCurrentRow = 1
'collectFiles "C:\Documents and Settings\Doug\Desktop\Converted Images" '_
collectFiles "C:\Documents and Settings\Doug\Desktop\Copy of Dog Stuff\Dog Training\Course Lessons\Unit 1\Lesson 1" _
, ActiveSheet _
, ".jpg" _
, 1
Application.ScreenUpdating = True
End Sub
Public Sub collectFiles(ByRef path As String, ByRef ws As Excel.Worksheet, _
ByRef fileType As String, ByVal iColumn As Long)
Dim Folder As Object
Dim file As Object
Dim fldr As Object
Dim blnMoveBackColumn As Boolean
Set Folder = oFSO.GetFolder(path)
ws.Cells(iCurrentRow, iColumn).Value = Folder.Name
iColumn = iColumn + 1
iCurrentRow = iCurrentRow + 1
For Each file In Folder.Files
If (LCase(Right(file, 4)) = LCase(fileType)) Then
With ws.Cells(iCurrentRow, iColumn)
.Value = file.Name
.AddComment.Shape.Fill.UserPicture file.path
.Comment.Shape.Width = 1100
.Comment.Shape.Height = 647
iCurrentRow = iCurrentRow + 1
End With
End If
Next file
For Each fldr In Folder.Subfolders
collectFiles fldr.path, ws, fileType, iColumn
Next fldr
End Sub