Dynamic References to Word?

  • Thread starter Thread starter Newbie
  • Start date Start date
N

Newbie

Hello
As the Late Binding seems very slow, I would like to create a reference on
Word 2000 or Word 2003 (Several PCs are running Office 2000, some others are
running Office 2003.
How can i create a Reference for Microsoft Word 9.0 or for Microsoft Word
11.0 (2000 and 2003)?
How to remove this Reference after the VBA procedure has done its work?
Thanks
 
Sub ActivateWordLibrary()

Dim R

On Error Resume Next

'no need to carry on if the Word Object Library is already there
'---------------------------------------------------------------
For Each R In ThisWorkbook.VBProject.References
If R.GUID = "{00020905-0000-0000-C000-000000000046}" Then
Exit Sub
End If
Next

ThisWorkbook.VBProject.References.AddFromGuid _
GUID:="{00020905-0000-0000-C000-000000000046}", _
Major:=0, Minor:=0

On Error GoTo 0

End Sub

You can remove the reference after, but not really neccessary.

RBS
 
Thanks a lot RB Smissaert !

1° - Does this procedure work if Word 2000 is installed as well with Word
2003 installed?
2° - I need to remove the reference because another VBA procedure (which
doesn't uses Word) hangs if the reference is still there!
Thanks again !

Newbie
 
Yes, should work with all versions of Word as it does Major:=0, Minor:=0.


To remove do this:

Sub RemoveWordReference()

RemoveReference "Word"

End Sub

Sub RemoveReference(strReference As String)

On Error GoTo ERROROUT

Dim R As Object

For Each R In ThisWorkbook.VBProject.References
If R.Name = strReference Then
ThisWorkbook.VBProject.References.Remove R
Exit Sub
End If
Next

ERROROUT:
On Error GoTo 0

End Sub

As it does Dim R As Object, rather than R as Reference you don't need a
reference to
Microsoft Visual Basic for Applications Extensibility.


RBS
 
Thanks a lot RBS !
Very useful!
PS : Where can I found all the GUID such as
"{00020905-0000-0000-C000-000000000046} ???
Thanks again
 
Look in the registry although I suspect Bart set a reference and then
queried the reference with VBA.

from the immediate window as an example:

? thisworkbook.vbProject.references(2).Guid
{00020813-0000-0000-C000-000000000046}
? thisworkbook.VBProject.References(2).Name
Excel
? thisworkbook.vbProject.references(7).Guid
{00020905-0000-0000-C000-000000000046}
? thisworkbook.VBProject.References(7).Name
Word
 
The way to get those GUID's is like this:
First set the reference manually in the VBE under Tools, References.
Then run code like this:


Sub GetLibraryGUID()

Dim c As Byte
Dim myCheck As Long
Dim P As Boolean
Dim rng As Range
Dim i As Byte

c = ActiveWorkbook.VBProject.References.Count

On Error Resume Next
Dim Message, Title, Default, T As Single
Message = "NUMBER ?" & Chr(13) & "________"
Title = " GET REFERENCES GUID ( 1 TO " & c & " )"
Default = c
T = InputBox(Message, Title, Default, 3500, 3500)

If Not T Mod 1 = 0 Then
Exit Sub
End If

If T < 1 Or T > c Then
Exit Sub
End If

MsgBox "REFERENCE ( " & T & " ) NAME : " & _
ActiveWorkbook.VBProject.References(T).Name & vbCrLf & vbCrLf & _
"MAJOR : " & _
ActiveWorkbook.VBProject.References.Item(T).Major & _
vbCrLf & vbCrLf & "MINOR : " & _
ActiveWorkbook.VBProject.References.Item(T).Minor & _
vbCrLf & vbCrLf & _
"GUID ( " & T & " ) : " & _
ActiveWorkbook.VBProject.References.Item(T).GUID, , _
" REFERENCES GUID : ITEM " & T

myCheck = MsgBox(" PUT INFORMATION IN SHEET ?", _
vbYesNo, " GetLibraryGUID")

If myCheck = vbNo Then
Exit Sub
End If

If ActiveSheet.ProtectContents = True Then
P = True
ActiveSheet.Unprotect
Else
P = False
End If

Range(Cells(ActiveCell.Row, ActiveCell.Column), _
Cells(ActiveCell.Row + 3, ActiveCell.Column + 1)).Select

For Each rng In Selection.Cells
If Not IsEmpty(rng) Then
i = i + 1
End If
Next

If i > 0 Then
myCheck = MsgBox(" OVERWRITE DATA IN THIS RANGE ?", _
vbYesNo, " GetLibraryGUID")
If myCheck = vbNo Then
Exit Sub
End If
End If

On Error Resume Next
ActiveCell.Value = "NAME :"
ActiveCell.Offset(1, 0).Value = "MAJOR :"
ActiveCell.Offset(2, 0).Value = "MINOR :"
ActiveCell.Offset(3, 0).Value = "GUID :"
ActiveCell.Offset(0, 1).Value = _
ActiveWorkbook.VBProject.References(T).Name
ActiveCell.Offset(1, 1).Value = _
ActiveWorkbook.VBProject.References.Item(T).Major
ActiveCell.Offset(2, 1).Value = _
ActiveWorkbook.VBProject.References.Item(T).Minor
ActiveCell.Offset(3, 1).Value = _
ActiveWorkbook.VBProject.References.Item(T).GUID

If P = True Then
ActiveSheet.Protect
End If

End Sub

That will give you all the information you need.
Keep in mind that you can do Major:=0, Minor:=0 to avoid a problem where you
specified a higher version than the one on the user's machine.


RBS
 
Thanks a lot Tom !


Tom Ogilvy said:
Look in the registry although I suspect Bart set a reference and then
queried the reference with VBA.

from the immediate window as an example:

? thisworkbook.vbProject.references(2).Guid
{00020813-0000-0000-C000-000000000046}
? thisworkbook.VBProject.References(2).Name
Excel
? thisworkbook.vbProject.references(7).Guid
{00020905-0000-0000-C000-000000000046}
? thisworkbook.VBProject.References(7).Name
Word
Click to expand...
 
Wonderful indeed !
Thanks a lot!

Newbie

RB Smissaert said:
The way to get those GUID's is like this:
First set the reference manually in the VBE under Tools, References.
Then run code like this:


Sub GetLibraryGUID()

Dim c As Byte
Dim myCheck As Long
Dim P As Boolean
Dim rng As Range
Dim i As Byte

c = ActiveWorkbook.VBProject.References.Count

On Error Resume Next
Dim Message, Title, Default, T As Single
Message = "NUMBER ?" & Chr(13) & "________"
Title = " GET REFERENCES GUID ( 1 TO " & c & " )"
Default = c
T = InputBox(Message, Title, Default, 3500, 3500)

If Not T Mod 1 = 0 Then
Exit Sub
End If

If T < 1 Or T > c Then
Exit Sub
End If

MsgBox "REFERENCE ( " & T & " ) NAME : " & _
ActiveWorkbook.VBProject.References(T).Name & vbCrLf & vbCrLf & _
"MAJOR : " & _
ActiveWorkbook.VBProject.References.Item(T).Major & _
vbCrLf & vbCrLf & "MINOR : " & _
ActiveWorkbook.VBProject.References.Item(T).Minor & _
vbCrLf & vbCrLf & _
"GUID ( " & T & " ) : " & _
ActiveWorkbook.VBProject.References.Item(T).GUID, , _
" REFERENCES GUID : ITEM " & T

myCheck = MsgBox(" PUT INFORMATION IN SHEET ?", _
vbYesNo, " GetLibraryGUID")

If myCheck = vbNo Then
Exit Sub
End If

If ActiveSheet.ProtectContents = True Then
P = True
ActiveSheet.Unprotect
Else
P = False
End If

Range(Cells(ActiveCell.Row, ActiveCell.Column), _
Cells(ActiveCell.Row + 3, ActiveCell.Column + 1)).Select

For Each rng In Selection.Cells
If Not IsEmpty(rng) Then
i = i + 1
End If
Next

If i > 0 Then
myCheck = MsgBox(" OVERWRITE DATA IN THIS RANGE ?", _
vbYesNo, " GetLibraryGUID")
If myCheck = vbNo Then
Exit Sub
End If
End If

On Error Resume Next
ActiveCell.Value = "NAME :"
ActiveCell.Offset(1, 0).Value = "MAJOR :"
ActiveCell.Offset(2, 0).Value = "MINOR :"
ActiveCell.Offset(3, 0).Value = "GUID :"
ActiveCell.Offset(0, 1).Value = _
ActiveWorkbook.VBProject.References(T).Name
ActiveCell.Offset(1, 1).Value = _
ActiveWorkbook.VBProject.References.Item(T).Major
ActiveCell.Offset(2, 1).Value = _
ActiveWorkbook.VBProject.References.Item(T).Minor
ActiveCell.Offset(3, 1).Value = _
ActiveWorkbook.VBProject.References.Item(T).GUID

If P = True Then
ActiveSheet.Protect
End If

End Sub

That will give you all the information you need.
Keep in mind that you can do Major:=0, Minor:=0 to avoid a problem where you
specified a higher version than the one on the user's machine.


RBS
Click to expand...
 
RBS,
I tried your macro but on the first line, c =
ActiveWorkbook.VBProject.References.Count
it bumps on the "Error # '1004' : the programming access to the Visual Basic
project is not reliable"
What is my problem?
Thanks again!
 
Just for interest, not sure what you gain with Byte, it is much shower than
Long. I get it at about 16 times slower. (Integer is about 10 times
slower). (and I don't think you are saving any space either - probably
using the same amount of space although I haven't explored it).
 
I am sure you are right. This is some old code I wrote many years ago.
Would do it all a bit different now, including not doing all those upper
case characters!

RBS
 
You will have to lower security in Excel by doing:
Tools, Macro, Security, Security level: Low or medium
Trusted sources: tick both.

RBS
 
This will all do it a bit better.
Will dump all the references of all open projects:

Sub ListExcelReferences()

'to list all the references in Excel
'-----------------------------------

Dim i As Long
Dim n As Long
Dim iRefCount As Long
Dim VBProj As Object

Cells.Clear

Cells(1).Value = "Project name"
Cells(2).Value = "Project file"
Cells(3).Value = "Reference Name"
Cells(4).Value = "Description"
Cells(5).Value = "FullPath"
Cells(6).Value = "GUID"
Cells(7).Value = "Major"
Cells(8).Value = "Minor"

On Error Resume Next 'as an un-saved workbook has no filename yet

For Each VBProj In Application.VBE.VBProjects
n = n + 1
With VBProj
iRefCount = .References.Count
With .References
For i = 1 To iRefCount
n = n + 1
If i = 1 Then
Cells(n, 1).Value = VBProj.Name
Cells(n, 2).Value = VBProj.Filename
If Err.Number = 76 Then 'Path not found
Cells(n, 2).Value = "Project not saved yet"
Err.Clear
End If
End If
Cells(n, 3).Value = .Item(i).Name
Cells(n, 4).Value = .Item(i).Description
Cells(n, 5).Value = .Item(i).FullPath
Cells(n, 6).Value = .Item(i).GUID
Cells(n, 7).Value = .Item(i).Major
Cells(n, 8).Value = .Item(i).Minor
Next i
End With
End With
Next

On Error GoTo 0

ThinRightBorder Range(Cells(2), Cells(n, 2))
Range(Cells(1), Cells(8)).Font.Bold = True
MediumBorder Range(Cells(1), Cells(8))
Range(Cells(1), Cells(n, 8)).Columns.AutoFit

End Sub

Sub MediumBorder(rng As Range, Optional wsh As Worksheet)

'puts a medium border around the passed range
'--------------------------------------------

Dim Sh As Worksheet

If wsh Is Nothing Then
Set Sh = ActiveWorkbook.ActiveSheet
Else
Set Sh = wsh
End If

With Sh.Range(rng.Address)
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With

End Sub

Sub ThinRightBorder(rng As Range)

With rng
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

End Sub


RBS
 
Hi Bart,

Really Wonderful !

Newbie

RB Smissaert said:
This will all do it a bit better.
Will dump all the references of all open projects:

Sub ListExcelReferences()

'to list all the references in Excel
'-----------------------------------

Dim i As Long
Dim n As Long
Dim iRefCount As Long
Dim VBProj As Object

Cells.Clear

Cells(1).Value = "Project name"
Cells(2).Value = "Project file"
Cells(3).Value = "Reference Name"
Cells(4).Value = "Description"
Cells(5).Value = "FullPath"
Cells(6).Value = "GUID"
Cells(7).Value = "Major"
Cells(8).Value = "Minor"

On Error Resume Next 'as an un-saved workbook has no filename yet

For Each VBProj In Application.VBE.VBProjects
n = n + 1
With VBProj
iRefCount = .References.Count
With .References
For i = 1 To iRefCount
n = n + 1
If i = 1 Then
Cells(n, 1).Value = VBProj.Name
Cells(n, 2).Value = VBProj.Filename
If Err.Number = 76 Then 'Path not found
Cells(n, 2).Value = "Project not saved yet"
Err.Clear
End If
End If
Cells(n, 3).Value = .Item(i).Name
Cells(n, 4).Value = .Item(i).Description
Cells(n, 5).Value = .Item(i).FullPath
Cells(n, 6).Value = .Item(i).GUID
Cells(n, 7).Value = .Item(i).Major
Cells(n, 8).Value = .Item(i).Minor
Next i
End With
End With
Next

On Error GoTo 0

ThinRightBorder Range(Cells(2), Cells(n, 2))
Range(Cells(1), Cells(8)).Font.Bold = True
MediumBorder Range(Cells(1), Cells(8))
Range(Cells(1), Cells(n, 8)).Columns.AutoFit

End Sub

Sub MediumBorder(rng As Range, Optional wsh As Worksheet)

'puts a medium border around the passed range
'--------------------------------------------

Dim Sh As Worksheet

If wsh Is Nothing Then
Set Sh = ActiveWorkbook.ActiveSheet
Else
Set Sh = wsh
End If

With Sh.Range(rng.Address)
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With

End Sub

Sub ThinRightBorder(rng As Range)

With rng
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

End Sub


RBS
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Same Office 2003 but different VBA Tools>Reference (object ref.) 5
How to create a Reference with VBA 8
Help with calling word reference from excel vba 7
Excel - how to prevent new office version from upgrading word object reference 3
Exporting Data to Word 2007 Using Reference to Word 11.0 Library 1
Reference Issue 1
VBA Refrerences which interfere 3
Which references will I need to reinstall on a new machine? 1

Back
Top