PDA

View Full Version : [SOLVED] VBA Code Library (this site)



alexanderd
05-19-2005, 01:05 PM
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:

johnske
05-19-2005, 02:50 PM
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


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

alexanderd
05-22-2005, 07:10 AM
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

johnske
05-22-2005, 08:08 AM
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

alexanderd
05-22-2005, 08:56 AM
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??!!!

johnske
05-22-2005, 09:08 AM
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 linesVERSION 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 = Falseso 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