Mr.Excel & Tracy Syrstad Book Product Catalog of Picture

[Fin Fang Foom]

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 ?

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

 

[starl]

1. Do you have the directory path setup?
2. Do you have a picture (jpg) in the folder
3. you're code is looking for a .Jpg file instead of .jpg - it is case sensitive

 

[Fin Fang Foom]

1. Do you have the directory path setup?
2. Do you have a picture (jpg) in the folder
3. you're code is looking for a .Jpg file instead of .jpg - it is case sensitive

1. picPath = "C:\MyPicture\"
2. My folder is named My Picture and the pictures are saved jpeg
3. I changed jpg to jpeg.


Should this code be place in the image form or the userform ? I tried both and it did not work.

Private Sub UserForm_Intialize()
picPath = "C:\MyPicture\"
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 & ".jpeg"
    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

 

[starl]

In the Userform.. not sure what you mean by imageform

Have you downloaded the sample files for the book?

 

[Fin Fang Foom]

I'm sorry I meant went I create the userform then I insert the image control onto the userform.

I was looking for a example for the "Product Catalog of Pictures" but I could not find one. Do you have one in handy ?

 

[starl]

Well, there are samples in the samples files for the book - did you download them?

 

[Fin Fang Foom]

Where or what page in the book that I could find the link to download the sample files ?

 

[starl]

from the sound of it, you have a newer version - so try page 7 of the book - there should be a link. If it's not there, let me know and I will PM it to you.
Almost all the code from the book is in the sample files so that you can test them.

 

[Fin Fang Foom]

All this time it was on page 7. I swear I was looking all over th book for a link of some kind.


Thank You So Much!