Excel

VBA Code Library, Attachment includes 75 code examples

Ease of Use

Easy

Version tested with

2000,2003 

Submitted by:

johnske

Description:

You can import and export code modules and userforms or run procedures. 

Discussion:

It's often a pain to search through workbooks to find a handy procedure you might want to use somewhere else. This Excel code library allows you to save all these handy snippets of code, userforms, and class modules in one location. you can then view the code or run it to see whether it suits what you want to do now. (Note that you can also save your Word, Outlook, etc. modules in here but you generally won't be able to run them).... MOST of the examples in the attachment are my own code but there are a few that I have picked up from various places. Please note that I often lose track of where I get code samples from, so if you do recognize code that may perhaps be 'yours' and it has not been acknowledged therein as such, my sincerest apologies to you, but you do have the small consolation that it has been recognized as being a useful, neat, or otherwise handy piece of code worthy of inclusion in a 'library' by a wannabe coder ) ... The code for the library (below) caters for up to 200 procedures, I think if you have any more than that it will become hard to find a given procedure and it would be more advisable to make another library (a copy) to include any further code. NOTE THAT THE CODE BELOW IS FOR YOU TO CREATE YOUR OWN LIBRARY FROM SCRATCH. IT'S ADVISABLE TO JUST DOWNLOAD THE ATTACHMENT AND REMOVE ANY CODE YOU DON'T WANT. 

Code:

instructions for use

			

'*************************************************** '*************************************************** '<< PASTE INTO THE "ThisWorkbook" MODULE >> Option Explicit Private Sub Workbook_Activate() Sheet3.Activate Sheet3.Name = "VB Components" Windows.Arrange With ActiveWindow .SmallScroll ToLeft:=256 .SmallScroll Up:=65536 End With On Error Resume Next '< error = reference already set 'set reference to Microsoft Visual Basic for Applications 'Extensibility 5.3 ThisWorkbook.VBProject.References.AddFromGuid _ "{0002E157-0000-0000-C000-000000000046}", 5, 3 End Sub '*************************************************** '*************************************************** '*************************************************** '*************************************************** '<< PASTE INTO THE "Sheet3" MODULE >> Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim N& If Target.row = 1 Then Exit Sub 'close any visible modules On Error Resume Next '< already minimized For N = 1 To ActiveWorkbook.VBProject.VBComponents.Count Application.VBE.Windows(N).WindowState = vbext_ws_Minimize Next 'view a procedure On Error Goto SelectModule '< next line errors out for forms Application.Goto Target.Text Application.VBE.ActiveWindow.WindowState = vbext_ws_Maximize Goto Finish SelectModule: On Error Resume Next If Target.Column = 1 Or Target.Column = 2 Or Target.Column = 2 Or Target.Column = 3 Then 'select a module Application.ScreenUpdating = False ActiveCell.Rows.EntireRow.Columns(1).Select If Selection = Empty Then Do Until Selection <> Empty ActiveCell.offset(-1, 0).Activate Loop End If 'view a module ThisWorkbook.VBProject.VBComponents _ (Selection).CodeModule _ .CodePane.Show Application.VBE.ActiveWindow.WindowState = vbext_ws_Maximize End If Finish: End Sub '*************************************************** '*************************************************** '*************************************************** '*************************************************** '<< PASTE INTO THE "Userform1" MODULE >> Option Explicit Private Sub UserForm_Activate() Dim MyList$(200, 1) Dim Count&, M&, N& Dim Component As VBComponent Height = 302 Width = 205 With ListBox1 .BoundColumn = 0 .ColumnWidths = "200" .Font = "Tahoma" .Font.Size = 9 .Left = 10 .Top = 10 .Height = 300 .Width = 200 End With '************************************************ If Sheet3.[IV1] = "RunCode" Then Caption = "Run Code (Single-Click)" ListBox1.ControlTipText = "Click the macro you want to run" '//heading MyList(0, 0) = "PROCEDURES" '//define list For N = 1 To 200 MyList(N, 0) = Sheet3.[B1].offset(N, 0) Next '//load list to listbox ListBox1.List = MyList DoEvents Exit Sub '************************************************ ElseIf Sheet3.[IV1] = "ExportCode" Then Caption = "Export Code Module (Double-Click)" ListBox1.ControlTipText = "DOUBLE-Click the module you want to export" MyList(0, 0) = "COMPONENT NAME" N = 1 For Each Component In ActiveWorkbook.VBProject.VBComponents MyList(N, 0) = Component.Name N = N + 1 Next ListBox1.List = MyList DoEvents Exit Sub '************************************************ ElseIf Sheet3.[IV1] = "RemoveCode" Then Caption = "Remove Code Module (Double-Click)" ListBox1.ControlTipText = "DOUBLE-Click the module you want to remove" '//heading MyList(0, 0) = "COMPONENT NAME" N = 1 For Each Component In ActiveWorkbook.VBProject.VBComponents Select Case N Case 1 To 5 'don't list 1 to 5 Case Else MyList(N - 5, 0) = Component.Name End Select N = N + 1 Next ListBox1.List = MyList DoEvents Exit Sub '************************************************ End If End Sub Private Sub listbox1_Click() If Sheet3.[IV1] <> "RunCode" Then Exit Sub UserForm1.Hide 'run the code If ListBox1.Text = "RunTheCode" Then MsgBox "Creates infinite loop - not advisable" Set UserForm1 = Nothing Exit Sub ElseIf ListBox1.Text = Empty Then MsgBox "? You selected (blank) ?" Set UserForm1 = Nothing Exit Sub Else On Error Goto ErrorMsg Run (ListBox1.Text) 'unload the form Unload Me DoEvents Exit Sub End If ErrorMsg: MsgBox "Sorry, this can't be 'run' as such, " & ListBox1.Text & " is" & vbLf & _ "either a Function, Userform, or Class procedure..." Set UserForm1 = Nothing Exit Sub End Sub Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim N& If Sheet3.[IV1] = "ExportCode" Then With ThisWorkbook.VBProject For N = 1 To .VBComponents.Count If .VBComponents(N).Name = ListBox1.Text Then Application.VBE.ActiveVBProject.VBComponents(N) _ .Export (ActiveWorkbook.path & "\" & _ ListBox1.Text & ".bas") MsgBox .VBComponents(N).Name & " exported to " & _ ActiveWorkbook.path Exit For End If Next N End With Unload Me ElseIf Sheet3.[IV1] = "RemoveCode" Then Dim Query As VbMsgBoxResult With ActiveWorkbook.VBProject For N = 1 To .VBComponents.Count If .VBComponents(N).Name = ListBox1.Text Then Query = MsgBox("Are you sure? This will delete " & _ .VBComponents(N).Name, vbYesNo, _ "Remove Module?") If Query = vbNo Then Goto Cancelled .VBComponents.Remove .VBComponents(N) Exit For End If Next End With MousePointer = fmMousePointerHourGlass 'if a module is removed update the list If Cancel = False Then UPDATELIST Unload Me Exit Sub Cancelled: Unload Me End If End Sub '*************************************************** '*************************************************** '*************************************************** '*************************************************** '<< PASTE INTO THE "Module1" MODULE >> Option Explicit Sub ImportCodeModule() Dim Filt$, Title$, FileName$, Message As VbMsgBoxResult Do Filt = "VB Files (*.bas; *.frm; *.cls)(*.bas; *.frm; *.cls),*.bas;*.frm;*.cls" Title = "SELECT A FOLDER - CLICK OPEN TO IMPORT - CANCEL TO QUIT" FileName = Application.GetOpenFilename(FileFilter:=Filt, FilterIndex:=5, Title:=Title) On Error Goto Finish Application.VBE.ActiveVBProject.VBComponents.Import (FileName) Message = MsgBox(FileName & vbCrLf & " has been imported - more imports?", vbYesNo, "More Imports?") Loop Until Message = vbNo UPDATELIST Finish: Message = vbYes End Sub Sub ExportCodeModule() Sheet3.[IV1] = "ExportCode" UserForm1.Show End Sub Sub RemoveCodeModule() Sheet3.[IV1] = "RemoveCode" UserForm1.Show End Sub Sub RunTheCode() Sheet3.[IV1] = "RunCode" UserForm1.Show End Sub Sub UPDATELIST() Dim N&, Count&, Typ& Dim Component As VBComponent Application.ScreenUpdating = False Sheet3.Name = "VB Components" Sheets("VB Components").Activate Cells.ClearContents Cells.Font.Size = 8 With Rows("1:1") .Font.Size = 9 .Font.Bold = True .Font.ColorIndex = 9 .Font.Underline = xlUnderlineStyleSingle End With [A1] = "COMPONENT NAME" [B1] = "PROCEDURES" [C1] = "COMPONENT TYPE" N = 2 For Each Component In ThisWorkbook.VBProject.VBComponents Range("A" & N) = Component.Name Typ = Component.Type If Typ = 1 Then Range("C" & N) = "Bas Module" If Typ = 2 Then Range("C" & N) = "Cls Module" If Typ = 3 Then Range("C" & N) = "UserForm" If Typ = 11 Then Range("C" & N) = "ActiveX" If Typ = 100 Then Range("C" & N) = "Book/Sheet Cls Module" With Component.CodeModule Count = .CountOfDeclarationLines + 1 Do Until Count >= .CountOfLines Range("B" & N) = .ProcOfLine(Count, vbext_pk_Proc) Count = Count + .ProcCountLines(.ProcOfLine _ (Count, vbext_pk_Proc), vbext_pk_Proc) If Count < .CountOfLines Then N = N + 1 Loop End With N = N + 1 Next Columns.AutoFit DoBorders ActiveWorkbook.Save End Sub Sub DoBorders() With [A1:C500] With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = 15 End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = 15 End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = 15 End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = 15 End With With .Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = 15 End With With .Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlHairline .ColorIndex = 15 End With End With End Sub '*************************************************** '***************************************************

How to use:

  1. (Note: it's easiest to just download the attachment and use it, however if you want to do all this yourself ) )....
  2. Open an Excel workbook
  3. Select Tools/Macro/Visual Basic Editor
  4. In the VBE window, select View/Project Explorer
  5. Select the 'ThisWorkbook' Module, copy and paste the code for it from above
  6. Now place the mouse pointer anywhere inside this code, and click
  7. Run/Run Sub/UserForm in the VBE toolbar (this sets a required reference)
  8. Select the 'Sheet3' Module, copy and paste the code for it from above
  9. Now select Insert/Userform (this will create Userform1)
  10. In the Toolbox shown, click 'listbox', now put the mouse pointer near the top left of the Userform and move the pointer down and to the right to create ListBox1
  11. Double-click either the listbox or userform and a code pane will appear
  12. Delete any code in this code pane and copy and paste the code for Userform1 from above
  13. Select Insert/Module, copy and paste the code for it from above
  14. Now select File/Close and Return To Microsoft Excel
  15. Save your work
 

Test the code:

  1. First select Tools/Macro/Macros.../UPDATELIST/Run to list the modules to initialize...
  2. You now have any of the following choices
  3. Select Tools/Macro/Macros.../ImportCodeModule/Run to import modules
  4. Select Tools/Macro/Macros.../ExportCodeModule/Run to export modules
  5. Select Tools/Macro/Macros.../RemoveCodeModule/Run to remove modules
  6. Select Tools/Macro/Macros.../RunTheCode/Run to run code contained in the modules (CAUTION: It's up to you, the coder, to ensure that any code you've imported will not delete or otherwise inadvertently alter wanted sheets in the library if you choose to run the code inside it)
 

Sample File:

VBAcodeLibrary.zip 109.03KB 

Approved by mdmackillop


This entry has been viewed 1366 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2014 VBA Express