Dynamic References to Word?

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
 
R

RB Smissaert

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
 
N

Newbie

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
 
R

RB Smissaert

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
 
N

Newbie

Thanks a lot RBS !
Very useful!
PS : Where can I found all the GUID such as
"{00020905-0000-0000-C000-000000000046} ???
Thanks again
 
T

Tom Ogilvy

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
 
R

RB Smissaert

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
 
N

Newbie

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...
 
N

Newbie

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...
 
N

Newbie

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

Tom Ogilvy

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).
 
R

RB Smissaert

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
 
R

RB Smissaert

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

RBS
 
R

RB Smissaert

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
 
N

Newbie

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...
 
R

RB Smissaert

No trouble, I had the code already.
I take it you got this all fixed then.

RBS
 

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

How to create a Reference with VBA 8
Same Office 2003 but different VBA Tools>Reference (object ref.) 5
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
VBA Refrerences which interfere 3
Which references will I need to reinstall on a new machine? 1
Problem updating references 8

Top