VBA Code Library (this site)

this was the answer to my prayer. somwhere to place all my snippits i have used / gathered an put away for a rainy day.

all went exceptionally well (i used the DIY version ) worked perfectly no problems and being filled with all the snippits i can find. except for ONE

i tried to import " API " bits and it threw a wobbler and came off the rails

Can the code be extended so that you can import " API " ?
can a further colum be added so that you can comment the work ?

http://www.vbaexpress.com/kb/getarticle.php?kb_id=403

:bow:

Hi alexander,

Not entirely sure what you mean here - bas, cls, and any frm modules with API calls in them should be imported ok (a module is just a module:dunno - basically, a text document). If you mean import some other form/type of module, just add the extension in here

Code:

---

Filt = "VB Files (*.bas; *.frm; *.cls)(*.bas; *.frm; *.cls),*.bas;*.frm;*.cls"

---

e.g. to include text documents, with the extension .txt you would have

Code:

---

Filt = "VB Files (*.bas; *.frm; *.cls; *.txt)(*.bas; *.frm; *.cls; *.txt),*.bas;*.frm;*.cls; *.txt"

---

Further column for comments where?

Regards,
John

thank you for your response, at present there are only 3 colums in the excel work book. i would like to be able to include a 4th colum where i can place comments ect.

this is the module i was trying to save as a snippit. to no avail.

Code:

---

' MODULE NAME:    USERFORM RESIZER CLASS
'* AUTHOR & DATE:  STEPHEN BULLEN, Business Modelling Solutions Ltd.
'* CONTACT:        Stephen@BMSLtd.co.uk
'* WEB SITE:        http://www.BMSLtd.co.uk
' DESCRIPTION:    Handles the resizing and repositioning of controls on a userform
'This class makes a userform resizable and handles the resizing of all the controls on the userform,
'such that their physical dimensions (e.g. size and position) change as the form is resized.
'Note that this is not a form 'magnifier', in that it does not alter font sizes.
'To specify which control(s) to resize (and how), you set the control's .Tag property at design time to
'indicate that the control's top, left, width and height should be adjusted as the form's size changes.
'Use the letters t, l, w and h in any order (or not at all) to state that the property should change as the form
'is resized.  Follow the property by a decimal to indicate that the control should change by a percentage of the
'form's change.
'For example:
'  hw          Sets the control's height and width to change with the form (e.g. if there's a single list box on the form)
'  tl          Sets the contol's top and left to change in line with the form (e.g. to keep it in the bottom-right corner)
'  w0.5        Sets the control's width to change by 0.5 that of the form's width change
'  w0.5l0.5    Sets the control's width and position to change by 0.5 that of the form's width change
 
Option Explicit
 
'Windows API calls to do all the dirty work!
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
Private Const GWL_STYLE As Long = (-16)          'The offset of a window's style
Private Const WS_THICKFRAME As Long = &H40000    'Style to add a sizable frame
Private Const SW_SHOW As Long = 5
 
Dim moForm As Object
Dim mdWidth As Double
Dim mdHeight As Double
 
'Property to set the userform to be resizable
Public Property Set Form(oNew As Object)
Dim hWndForm As Long, iStyle As Long
'Remember the form for later
    Set moForm = oNew
'Get the userform's window handle
    If Val(Application.Version) < 9 Then
        hWndForm = FindWindow("ThunderXFrame", moForm.Caption)  'XL97
    Else
        hWndForm = FindWindow("ThunderDFrame", moForm.Caption)  'XL2000
    End If
'Make the form resizable
    iStyle = GetWindowLong(hWndForm, GWL_STYLE)
    iStyle = iStyle Or WS_THICKFRAME
    SetWindowLong hWndForm, GWL_STYLE, iStyle
'Show the window with the changes
    ShowWindow hWndForm, SW_SHOW
    DrawMenuBar hWndForm
    SetFocus hWndForm
'Remember the current size for later
    mdWidth = moForm.Width
    mdHeight = moForm.Height
End Property
 
'Handle the form's resize event, by resizing and repositioning controls
Public Sub FormResize()
Dim dWidthAdj As Double, dHeightAdj As Double, sTag As String
    Dim oCtl As MSForms.Control
'If not set before, remember the old width and height
    If mdWidth = 0 Then mdWidth = moForm.Width
    If mdHeight = 0 Then mdHeight = moForm.Height
'How much are we changing by?
    dWidthAdj = moForm.Width - mdWidth
    dHeightAdj = moForm.Height - mdHeight
'Check if we can perform the adjustment (i.e. widths and heights can't be -ve)
    For Each oCtl In moForm.Controls
        With oCtl
            sTag = UCase(.Tag)
'Check if the left would become -ve
            If InStr(1, sTag, "L", vbBinaryCompare) Then
                If .Left + dWidthAdj <= 0 Then moForm.Width = mdWidth
            End If
'Check if the width would become -ve
            If InStr(1, sTag, "W", vbBinaryCompare) Then
                If .Width + dWidthAdj <= 0 Then moForm.Width = mdWidth
            End If
'Check if the top would become -ve
            If InStr(1, sTag, "T", vbBinaryCompare) Then
                If .Top + dHeightAdj <= 0 Then moForm.Height = mdHeight
            End If
'Check if the height would become -ve
            If InStr(1, sTag, "H", vbBinaryCompare) Then
                If .Height + dHeightAdj <= 0 Then moForm.Height = mdHeight
            End If
        End With
    Next
'OK to do it, so perform the resize
    dWidthAdj = moForm.Width - mdWidth
    dHeightAdj = moForm.Height - mdHeight
'Loop through the controls on the form, changing their size and/or position
    For Each oCtl In moForm.Controls
        With oCtl
            sTag = UCase(.Tag)
            If InStr(1, sTag, "L", vbBinaryCompare) Then .Left = .Left + dWidthAdj * ResizeFactor(sTag, "L")
            If InStr(1, sTag, "T", vbBinaryCompare) Then .Top = .Top + dHeightAdj * ResizeFactor(sTag, "T")
            If InStr(1, sTag, "W", vbBinaryCompare) Then .Width = .Width + dWidthAdj * ResizeFactor(sTag, "W")
            If InStr(1, sTag, "H", vbBinaryCompare) Then .Height = .Height + dHeightAdj * ResizeFactor(sTag, "H")
        End With
    Next
'Remember the new dimensions for next time
    mdWidth = moForm.Width
    mdHeight = moForm.Height
End Sub
 
'Get the resize factor from the control's Tag property
Private Function ResizeFactor(sTag As String, sChange As String)
Dim I As Integer, d As Double
'Find the position of the required change designator (L, T, W or H)
    I = InStr(1, sTag, sChange, vbBinaryCompare)
    If I > 0 Then
'Get the value of any numbers following the designator
        d = Val(Mid$(sTag, I + 1))
'If none there, change by 100%
        If d = 0 Then d = 1
    End If
ResizeFactor = d
End Function

---

Hi alexander,

That's a class module... Paste it into a notepad doc and save it as CFormResizer.cls - you'll then be able to import it without any probs - I just did (have attached a zip copy for you).

As far as a 4th column for comments is concerned, sorry, it was not really practical to code for that, you'll just have to type your own comments in the 4th column :devil:

Regards,
John :thumb

thank you for a quick response.

i am still getting an error in Sub Updatelist. the following line throws a wobbler

Code:

---

Count = Count + .ProcCountLines(.ProcOfLine _
(Count, vbext_pk_Proc), vbext_pk_Proc)

---

ps i am using excel2003.

i removed " .cls" from my list and re-inported it works fine am i missing something or done something wrong.
i will re down load the file and start from scratch??!!!

Hi Alexader,

I don't know why you're getting a problem there... Try downloading the zipped version of the code library and importimg the module into it.

PS: The copy of the class module you've pasted above was missing these lines[vba]VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "CFormResizer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False[/vba]so don't use it - the zip copy I attached above has the missing lines included - the missing lines may've been causing a problem :dunno