I use this to load pictures on a sheet. Right now it includes bringing in the file name and putting it below the pictures. I need to disable that part and cannot find the way unless I get an error. Could someone look at this and suggest a way to disable the file name part? Thanks
Code:
Sub LoadPicsLeftToRight()
On Error GoTo LoadPics_Error
Application.ScreenUpdating = False
GetParms:
Do
startrow = Application.InputBox("Start Images at row: ", , Default:=recstartrow, Type:=1)
If startrow = False Then GoSub DesireToCancel
Loop While startrow = False
Do
rowshift = Application.InputBox("Place Images with this many rows of separation: ", , Default:=recrowshift, Type:=1)
If rowshift = False Then GoSub DesireToCancel
Loop While rowshift = False
Do
startcol = Application.InputBox("Start Images at column: ", , Default:=recstartcol, Type:=1)
If startcol = False Then GoSub DesireToCancel
Loop While startcol = False
Do
colshift = Application.InputBox("Place Images with this many columns of separation: ", , Default:=reccolshift, Type:=1)
If colshift = False Then GoSub DesireToCancel
Loop While colshift = False
Do
DfltPicHeight = Application.InputBox("The Images should have default height of: ", , Default:=recDfltPicHeight, Type:=1)
If DfltPicHeight = False Then GoSub DesireToCancel
Loop While DfltPicHeight = False
Do
DfltPicWidth = Application.InputBox("The Images should have default width of: ", , Default:=recDfltPicWidth, Type:=1)
If DfltPicWidth = False Then GoSub DesireToCancel
Loop While DfltPicWidth = False
Do
DfltColWidth = Application.InputBox("Default Column widths to: ", , Default:=recDfltColWidth, Type:=1)
If DfltColWidth = False Then GoSub DesireToCancel
Loop While DfltColWidth = False
Do
WrapAtCol = Application.InputBox("Jump to the next row if the image would be placed after column: ", , Default:=recWrapAtCol, Type:=1)
If WrapAtCol = False Then GoSub DesireToCancel
Loop While WrapAtCol = False
Process:
Do
RootPath = BrowseForFolder
If RootPath = "False" Then GoSub DesireToCancel
Loop While RootPath = "False"
If RootPath <> "False" Then RootPath = RootPath & "\"
LoadHashTable
If HashTable.Count < 1 Then Exit Sub
nextrow = startrow
nextcol = startcol
KillShapesII 'Deletes all shapes/pictures and text of the active sheet
With ActiveSheet
keez = HashTable.Keys ' Get the keys.
For i = 0 To HashTable.Count - 1 ' Iterate the array.
If HashTable.Exists(keez(i)) Then
picfile = HashTable.Item(keez(i))
.Cells(nextrow, nextcol).Select
'Method Insert Shape
'Set Shp = .Shapes.AddPicture(picfile, msoFalse, msoCTrue, .Cells(nextrow, nextcol).Left, .Cells(nextrow, nextcol).Top, DfltPicWidth, DfltPicHeight)
.Cells(nextrow, nextcol).RowHeight = Shp.Height
.Cells(nextrow, nextcol).ColumnWidth = DfltColWidth
.Cells(nextrow + 1, nextcol) = Replace(Replace(keez(i), ".jpg", ""), ".gif", "")
End If
'Determine the column for the next pic
nextcol = nextcol + 2
If nextcol > WrapAtCol Then
nextcol = startcol
nextrow = nextrow + rowshift
Else
nextcol = nextcol
nextrow = nextrow
End If
DoEvents 'Allows computer to process other things in intense loops
Next i
End With
On Error GoTo 0
Exit Sub
DesireToCancel:
'Manages messaging to user & prog. flow when cancel condition may be present
swCancel = MsgBox("Do you want to cancel?", vbYesNo)
Select Case swCancel
Case Is = vbYes
MsgBox "Exiting"
Exit Sub
Case Is = vbNo
Return
End Select
LoadPics_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure LoadPics " & vbLf & picfile
Err = 0
End Sub
