Putting It All Together

This is the complete code for the Picture Catalog userform:

Private Sub UserForm_Initialize()

1 Display pictures of each SKU selected on the worksheet 1 This may be anywhere from 1 to 36 pictures PicPath = "C:\qimage\qi" Dim Pics ()

1 resize the form

Me.Height = Int(0.98 * ActiveWindow.Height) Me.Width = Int(0.98 * ActiveWindow.Width)

' determine how many cells are selected 1 We need one picture and label for each cell CellCount = Selection.Cells.Count ReDim Preserve Pics(1 To CellCount)

' Figure out the size of the resized form TempHt = Me.Height TempWid = Me.Width

' The number of columns is a roundup of SQRT(CellCount) ' This will ensure 4 rows of 5 pictures for 20, etc. NumCol = Int(0.99 + Sqr(CellCount)) NumRow = Int(0.99 + CellCount / NumCol)

' Figure out the ht and wid of each square 1 Each column will have 2 pts to left & right of pics

CellWid = Application.WorksheetFunction.Max(Int(TempWid / NumCol) - 4, 1)

' each row needs to have 33 points below it for the label

CellHt = Application.WorksheetFunction.Max(Int(TempHt / NumRow) - 33, 1)

PicCount = 0 1 Counter variable LastTop = 2 MaxBottom = 1

1 Build each row on the form For x = 1 To NumRow

LastLeft = 3

' Build each column in this row For Y = 1 To NumCol

PicCount = PicCount + 1 If PicCount > CellCount Then

1 There are not an even number of pictures to fill ' out the last row Me.Height = MaxBottom + 100 Me.cbClose.Top = MaxBottom + 25 Me.cbClose.Left = Me.Width - 50 Repaint Exit Sub End If

ThisStyle = Selection.Cells(PicCount).Value

ThisDesc = Selection.Cells(PicCount).Offset(0, 1).Value fname = PicPath & ThisStyle & ".jpg"

TC = "Image" & PicCount

Me.Controls.Add bstrProgId:="forms.image.1", Name:=TC, Visible:=True

Me.Controls(TC).Top = LastTop

Me.Controls(TC).Left = LastLeft

Me.Controls(TC).AutoSize = True

On Error Resume Next

Me.Controls(TC).Picture = LoadPicture(fname) On Error GoTo 0

' The picture resized the control to full size ' determine the size of the picture Wid = Me.Controls(TC).Width Ht = Me.Controls(TC).Height WidRedux = CellWid / Wid HtRedux = CellHt / Ht If WidRedux < HtRedux Then Redux = WidRedux

Else

Redux = HtRedux End If

' Now resize the control Me.Controls(TC).AutoSize = False Me.Controls(TC).Height = NewHt Me.Controls(TC).Width = NewWid

Me.Controls(TC).PictureSizeMode = fmPictureSizeModeStretch Me.Controls(TC).ControlTipText = "Style " & _ ThisStyle & " " & ThisDesc

' Keep track of the bottom-most & right-most picture ThisRight = Me.Controls(TC).Left + Me.Controls(TC).Width ThisBottom = Me.Controls(TC).Top + Me.Controls(TC).Height If ThisBottom > MaxBottom Then MaxBottom = ThisBottom

' Add a label below the picture LC = "LabelA" & PicCount

Me.Controls.Add bstrProgId:="forms.label.1", Name:=LC, Visible:=True Me.Controls(LC).Top = ThisBottom + 1 Me.Controls(LC).Left = LastLeft Me.Controls(LC).Height = 18

Me.Controls(LC).Width = CellWid

Me.Controls(LC).Caption = "Style " & ThisStyle & " " & ThisDesc

1 Keep track of where the next picture should display LastLeft = LastLeft + CellWid + 4 Next Y 1 end of this row LastTop = MaxBottom + 21 + 16 Next x

Me.Height = MaxBottom + 100 Me.cbClose.Top = MaxBottom + 25 Me.cbClose.Left = Me.Width - 50 Repaint End Sub

0 0

Post a comment