macro for pics

[ronniemack]

I have a macro, from an old company that worked with excel 97. The general purpose of the macro is to lay pictures out on a sheet, 2 pics per page, the pics are numbered and the pages are numbered. Pretty eazy right. Well when used with excel 07 it makes pages, it makes photo numbers, but it piles all the pics up on top of each other. I can send the macro to anyone that might be able to help me. ANy ideas?

 

[tshooter]

Please post macro or snapshot of what u want.

 

[ronniemack]

man I feel dumb. I cant cut or past anything into here.

 

[ronniemack]

Option Explicit
Public dlgFD As FileDialog
Public bPageBreak As Boolean
Public iPicCount As Long
Public iTop As Long
Public sRatio As Single
Public sLocation As Single
Public iHor As Single
Public iVer As Single
Public vPicture As Variant
Sub GetPhotos()
Set dlgFD = Application.FileDialog(msoFileDialogFilePicker)
bPageBreak = False
iPicCount = 1
iHor = 432
iVer = 300

With dlgFD

If .Show = -1 Then
Cells.RowHeight = 12
Cells.ColumnWidth = 4.4
Range("A1").Select

For Each vPicture In .SelectedItems
ActiveSheet.Pictures.Insert vPicture
ActiveSheet.Shapes(iPicCount).Select
sRatio = Selection.ShapeRange.Width / Selection.ShapeRange.Height
If sRatio < 1 Then
Application.Run "VertFormat"
Else
Application.Run "HorFormat"
End If
Application.Run "PageFormat"
iPicCount = iPicCount + 1
Next vPicture
Else
End
End If

End With

Set dlgFD = Nothing
Range("A1").Select
End Sub
Sub PrintSetup()
With ActiveSheet.PageSetup
.PrintArea = "$A:$S"
.CenterHeader = "&""Arial,Regular""&14Tricon Services, Inc."
.RightFooter = "&""Arial,Regular""Page &P"
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0.35)
.FooterMargin = Application.InchesToPoints(0.25)
.Orientation = xlPortrait
.CenterHorizontally = True
.Zoom = 100
End With

ActiveWindow.View = xlPageBreakPreview
ActiveWindow.Zoom = 66
End Sub
Sub Photowizard()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Run "GetPhotos"
Application.Run "PrintSetup"
End Sub
Sub VertFormat()
iTop = Selection.ShapeRange.Top
Selection.ShapeRange.Rotation = 270
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Width = iVer
Selection.ShapeRange.Height = iHor
sLocation = iTop - ((iHor - iVer) / 2)
Selection.ShapeRange.Top = sLocation
End Sub
Sub HorFormat()
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Width = iHor
Selection.ShapeRange.Height = iVer
End Sub
Sub PageFormat()
ActiveCell.Offset(26, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "Photo #" & iPicCount
ActiveCell.Offset(4, 0).Range("A1").Select
If bPageBreak = True Then
ActiveCell.PageBreak = xlPageBreakManual
bPageBreak = False
Else
bPageBreak = True
End If
End Sub