Fin Fang Foom
Well-known Member
- Joined
- Mar 20, 2005
- Messages
- 598
Hey everybody 
Well I got this code from the 2004:
VBA and Macros
for
Microsoft EExcel
Page 446-451
Its by Bill Jelen "Mr.Excel" and Tracy Syrstad
The problem I'm having is its not working. Its say on page 446, You can select any number of SKUs from an Excel Worksheet and hit a hot key to display the form. But what is SKUs?
And if I select 20 items on the worksheet "and I did" and hit a hot key "and I did" the pictures will display in the userform. But it does not.
I place this code in a regular userform and a image form and still it did not work.
Do you know what am I missing ?
Well I got this code from the 2004:
VBA and Macros
for
Microsoft EExcel
Page 446-451
Its by Bill Jelen "Mr.Excel" and Tracy Syrstad
The problem I'm having is its not working. Its say on page 446, You can select any number of SKUs from an Excel Worksheet and hit a hot key to display the form. But what is SKUs?
And if I select 20 items on the worksheet "and I did" and hit a hot key "and I did" the pictures will display in the userform. But it does not.
I place this code in a regular userform and a image form and still it did not work.
Do you know what am I missing ?
Code:
Private Sub UserForm_Intialize()
picPath = "C:\qimage\qi\"
Dim Pics()
Me.Height = Int(0.98 * ActiveWindow.Height)
Me.Width = Int(0.98 * ActiveWindow.Width)
CellCount = Selection.Cells.Count
ReDim Preserve Pics(1 To CellCount)
TempHt = Me.Height
Tempwid = Me.Width
NumCol = Int(0.99 + Sqr(CellCount))
NumRow = Int(0.99 + CellCount / NumCol)
CellWid = Application.WorksheetFunction.Max(Int(Tempwid / NumCol) - 4, 1)
CelHt = Application.WorksheetFunction.Max(Int(TemHt / NumRow) - 33, 1)
PicCount = 0
LastTop = 2
MaxBottom = 1
For x = 1 To NumRow
LastLeft = 3
For Y = 1 To NumCol
If PicCount > CellCount Then
Me.Height = MaxBottom + 100
Me.cbclose.Top = MaxBottom + 25
Me.cbclose.Left = Me.Width - 50
Repaint
Exit Sub
End If
ThisStyle = Selection.Cells(PicCount).Vaule
ThisDesc = Selection.Cells(PicCount).Offset(0, 1).Vaule
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
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
NewHt = Int(Ht * Redux)
NewWid = Int(Wid * Redux)
Me.Controls(TC).AutoSize = False
Me.Controls(TC).Height = NewHt
Me.Controls(TC).Width = NewWid
Me.Controls(TC).PictureSizeMode = fmPictureSizeModeStretch
Me.Controls(TC).ControlTipTex = "Style " & _
ThisStyle & " " & ThisDesc
ThisRight = Me.Controls(TC).Left + Me.Controls(TC).Width
ThisBottom = Me.Controls(TC).Top + Me.Controls(TC).Height
If ThisBottom > MaxBottom Then MaxBottom = ThisBottom
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
LastLeft = LastLeft + CellWid + 4
Next Y
LastTop = MaxBottom + 21 + 16
Next x
Me.Height = MaxBottom + 100
Me.cbclose.Top = MaxBottom + 25
Me.cbclose.Left = Me.Width - 50
Repaint
End Sub
