Microsoft Office Tutorials and References
In Depth Information
Creating a Photo Album
Dim Rng As Range¶
Dim MaxClm As Long¶
Dim Size As Long¶
'Change the following variables¶
'Hard code Folder value¶
'Folder = "C:\"¶
'Folder = "C:\My Documents\My Pictures"¶
'Let the user input folder value¶
Folder = Range("B1").Value¶
'Hard code LookInSubFolders value¶
'LookInSubFolders = False¶
'User inputs LookInSubFolders value¶
LookInSubFolders = Range("B2").Value¶
'Hard Code MaxClm value¶
'Insert 4 pictures per row¶
'MaxClm = 4¶
'User inputs MaxClm value¶
MaxClm = Range("B3").Value¶
'Hard Code Size value¶
'Use 3 worksheet columns for each picture¶
'Size = 3¶
'User inputs Size value¶
Size = Range("B4").Value¶
'This macro will insert all the images from a folder, inserting¶
'MaxClm pictures per row.¶
'Turn off screen updating¶
Application.ScreenUpdating = False¶
'Insert a new workbook with one worksheet¶
Set Sht = Workbooks.Add(xlWorksheet).Worksheets(1)¶
Rw = 1¶
With Application.FileSearch¶
.NewSearch¶
.LookIn = Folder¶
.SearchSubFolders = LookInSubFolders¶
.Filename = ".jpg"¶
.Execute¶
For i = 1 To .FoundFiles.Count¶
Clm = Clm + 1¶
If Clm > MaxClm Then¶
Clm = 1¶
Rw = Rw + Size * 3 + 1¶
End If¶
'Did Excel run out of rows ?¶
If Rw >= Sht.Rows.Count - Size * 3 + 1 Then¶
'Start over !¶
Clm = 1¶
Rw = 1¶
Set Sht = ActiveWorkbook.Sheets.Add(After:=Sht)¶
End If¶
'Set the range where pictures will be inserted¶
Set Rng = Sht.Cells(Rw, (Clm - 1) * (Size + 1) + 1)¶
Exl
Search JabSto ::




Custom Search