Consulting

Results 1 to 6 of 6

Thread: VBA Code Library (this site)

  1. #1

    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

    Last edited by alexanderd; 05-19-2005 at 01:10 PM. Reason: add link to p[age

  2. #2
    Administrator
    Chat VP
    VBAX Guru johnske's Avatar
    Joined
    Jul 2004
    Location
    Townsville, Australia
    Posts
    2,872
    Location
    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 - basically, a text document). If you mean import some other form/type of module, just add the extension in here

    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

    Filt = "VB Files (*.bas; *.frm; *.cls; *.txt)(*.bas; *.frm; *.cls; *.txt),*.bas;*.frm;*.cls; *.txt"
    Further column for comments where?

    Regards,
    John
    You know you're really in trouble when the light at the end of the tunnel turns out to be the headlight of a train hurtling towards you

    The major part of getting the right answer lies in asking the right question...


    Made your code more readable, use VBA tags (this automatically inserts [vba] at the start of your code, and [/vba ] at the end of your code) | Help those helping you by marking your thread solved when it is.

  3. #3
    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.


    ' 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

  4. #4
    Administrator
    Chat VP VBAX Guru johnske's Avatar
    Joined
    Jul 2004
    Location
    Townsville, Australia
    Posts
    2,872
    Location
    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

    Regards,
    John
    You know you're really in trouble when the light at the end of the tunnel turns out to be the headlight of a train hurtling towards you

    The major part of getting the right answer lies in asking the right question...


    Made your code more readable, use VBA tags (this automatically inserts [vba] at the start of your code, and [/vba ] at the end of your code) | Help those helping you by marking your thread solved when it is.

  5. #5
    thank you for a quick response.

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

    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??!!!

  6. #6
    Administrator
    Chat VP VBAX Guru johnske's Avatar
    Joined
    Jul 2004
    Location
    Townsville, Australia
    Posts
    2,872
    Location
    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
    You know you're really in trouble when the light at the end of the tunnel turns out to be the headlight of a train hurtling towards you

    The major part of getting the right answer lies in asking the right question...


    Made your code more readable, use VBA tags (this automatically inserts [vba] at the start of your code, and [/vba ] at the end of your code) | Help those helping you by marking your thread solved when it is.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •