While you're creating the macro, as you need references, you'll be adding them.
Once your Macro is completed, run the procedure below
(ListActiveVBEReferences). Make sure that the workbook containing your new
macro is the active workbook. This procedure will create a new worksheet
with a list of all your active references for the active workbook.
Using the GUIDs from this reference list, adjust the procedure below
(AddVbideReferencesFromGUID) to load the references you need. Then call the
procedure from a 'master' procedure that also calls your macro.
ie:
'==========================================
Sub MyMacro
Call AddVbideReferencesFromGUID 'loads references
Call YourMacro
End Sub
'==========================================
'==========================================
Public Sub ListActiveVBEReferences()
'On Error GoTo Err_ListActiveVBEReferences
Dim aryHiddensheets()
Dim refReference
Dim i As Integer, x As Integer
Dim iWorksheets As Integer, y As Integer
Dim strResultsTableName As String
strResultsTableName = "Active VBE References"
'check for an active workbook
If ActiveWorkbook Is Nothing Then
Workbooks.Add
End If
'Count number of worksheets in workbook
iWorksheets = ActiveWorkbook.Sheets.Count
'redim array
ReDim aryHiddensheets(1 To iWorksheets)
'put hidden sheets in an array, then unhide the sheets
For x = 1 To iWorksheets
If Worksheets(x).Visible = False Then
aryHiddensheets(x) = Worksheets(x).name
Worksheets(x).Visible = True
End If
Next
'Check for duplicate Worksheet name
i = ActiveWorkbook.Sheets.Count
For x = 1 To i
If Windows.Count = 0 Then Exit Sub
If UCase(Worksheets(x).name) = _
UCase(strResultsTableName) Then
Worksheets(x).Activate
If Err.Number = 9 Then
Exit For
End If
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Exit For
End If
Next
'Add new worksheet at end of workbook
' where results will be located
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
'Name the new worksheet and set up Titles
ActiveWorkbook.ActiveSheet.name = strResultsTableName
ActiveWorkbook.ActiveSheet.Range("A1").value = "Description"
ActiveWorkbook.ActiveSheet.Range("B1").value = "Name"
ActiveWorkbook.ActiveSheet.Range("C1").value = "GUID"
ActiveWorkbook.ActiveSheet.Range("D1").value = "#Major"
ActiveWorkbook.ActiveSheet.Range("E1").value = "#Minor"
ActiveWorkbook.ActiveSheet.Range("F1").value = "Path"
ActiveCell.Offset(1, 0).Select
For Each refReference In _
Application.VBE.ActiveVBProject.references
With ActiveCell
.value = refReference.Description
.Offset(0, 1).value = refReference.name
.Offset(0, 2).value = refReference.GUID
.Offset(0, 3).value = refReference.Major
.Offset(0, 4).value = refReference.Minor
.Offset(0, 5).value = refReference.FullPath
.Offset(1, 0).Select
End With
Next
'format worksheet
ActiveWindow.Zoom = 75
Range("A1:F1").Select
Range("F1").Activate
Selection.Font.Bold = True
Range("A2").Select
ActiveWindow.FreezePanes = True
Range("F1").Activate
Columns("A:F").EntireColumn.AutoFit
'format print options
On Error Resume Next
Call PageSetupXL4( _
CenterHead:="&B&16&U&A", _
CenterFoot:="Page &P of &N", _
LeftMarginInches:=0.25, _
RightMarginInches:=0.25, _
TopMarginInches:=1, _
BottomMarginInches:=1, _
HeaderMarginInches:=0.5, _
FooterMarginInches:=0.5, _
PrintGridlines:=True, _
Orientation:=xlLandscape, _
CenterHorizontally:=True, _
FirstPageNumber:="", _
Draft:=False, _
Zoom:=True, _
Order:=xlOverThenDown)
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintTitleColumns = ""
If .PrintTitleRows = "" Then
.PrintTitleRows = "$1:$1"
End If
If .PaperSize <> xlPaperLetter And _
.PaperSize <> xlPaperLegal Then
.PaperSize = xlPaperLetter '1
End If
End With
Range("A1:F1").Select
Range("F1").Activate
With Selection.Font
.name = "Tahoma"
.FontStyle = "Bold"
.Underline = xlUnderlineStyleSingleAccounting
End With
Columns("D:E").Select
Range("E1").Activate
With Selection
.HorizontalAlignment = xlCenter
End With
Columns("A:F").Select
Range("F1").Activate
Columns("A:F").EntireColumn.AutoFit
Columns("F:F").Select
If Selection.ColumnWidth > 50 Then
Selection.ColumnWidth = 50
End If
Columns("F:F").Select
With Selection
.WrapText = True
End With
Range("A2").Select
're-hide previously hidden sheets
On Error Resume Next
y = UBound(aryHiddensheets)
For x = 1 To y
Worksheets(aryHiddensheets(x)).Visible = False
Next
Application.Dialogs(xlDialogWorkbookName).Show
Exit_ListActiveVBEReferences:
Exit Sub
Err_ListActiveVBEReferences:
MsgBox "Error: " & Err & " - " & Err.Description
Resume Exit_ListActiveVBEReferences
End Sub
'======================================
'/=============================================/
Sub AddVbideReferencesFromGUID()
'Add references used in procedures
'
'
Dim aryReference() As String
Dim iErrorCounter As Long
Dim iReferences As Long, i As Long
Dim x As Long, y As Long
Dim iMajor As Long, iMinor As Long
Dim strADODB As String ' GUID reference
Dim strADOR As String ' GUID reference
Dim strADOX As String ' GUID reference
Dim strCDO As String ' GUID reference
Dim strExcel As String ' GUID reference
Dim strIWshRuntimeLibrary As String ' GUID reference
Dim strMSACAL As String ' GUID reference
Dim strMSForms As String ' GUID reference
Dim strOffice As String ' GUID reference
Dim strOutlook As String ' GUID reference
Dim strRefEdit As String ' GUID reference
Dim strScripting As String ' GUID reference
Dim strstdole As String ' GUID reference
Dim strVBA As String ' GUID reference
Dim strVBIDE As String ' GUID reference
Dim VarAddReference As Variant
'/--------VARIABLES--------------------------/
iReferences = 5 'add 5 references
iMajor = 20
iMinor = 20
'/-------------------------------------------/
On Error GoTo Err_AddVbideReferences
ReDim aryReference(iReferences, 2)
iErrorCounter = 0
' 'Microsoft ActiveX Data Objects 2.5 Library
aryReference(1, 1) = "ADODB"
aryReference(1, 2) = "{00000205-0000-0010-8000-00AA006D2EA4}"
' 'Microsoft ActiveX Data Objects Recordset 2.5 Library
aryReference(2, 1) = "ADOR"
aryReference(2, 2) = "{00000300-0000-0010-8000-00AA006D2EA4}"
'Microsoft ADO Ext. 2.5 for DDL and Security
aryReference(3, 1) = "ADOX"
aryReference(3, 2) = "{00000600-0000-0010-8000-00AA006D2EA4}"
'Microsoft CDO for Windows 2000 Library
aryReference(4, 1) = "CDO"
aryReference(4, 2) = "{CD000000-8B95-11D1-82DB-00C04FB1625D}"
'Microsoft Excel 9.0 Object Library
aryReference(5, 1) = "Excel"
aryReference(5, 2) = "{00020813-0000-0000-C000-000000000046}"
For i = 1 To iReferences
For x = iMajor To 0 Step -1
For y = iMinor To 0 Step -1
VarAddReference = _
ActiveWorkbook.VBProject.references. _
AddFromGuid(aryReference(i, 2), x, y)
Next y
Next x
Next i
Exit_AddVbideReferences:
Exit Sub
Err_AddVbideReferences:
iErrorCounter = iErrorCounter + 1
' if Reference already active, ignore error and exit
If Err = 32813 Then
iErrorCounter = 0
Resume Next
End If
If iErrorCounter > 4 Then
iErrorCounter = 0
Resume Next
End If
If Err = 438 Then
' Object doesn't support this property or method
' This error is often gotten first time thru an
' add reference routine
iErrorCounter = 0
Resume Next
End If
iErrorCounter = 0
Resume Next
End Sub
'/=============================================/
--
Hope this helps.
If it does, please click the Yes button.
Thanks in advance for your feedback.
Gary Brown
