Solved: IS there a better way of writing this Word Macro...It seems poorly done

[GreatBarrier]

This code was written 7 years ago by my ex-boss and i'm not very confident in his abilities. Is this the best this code can be, or is it possible to make it better?

It is supposed to insert a logo into a word document

Dim oRange As Object
Dim sAction As String

On Error GoTo InsertLogo
sAction = "Delete"

'If logo already exists, delete it
ActiveDocument.Shapes("logo for Email").Delete

'Set top margin to 2''
ActiveDocument.PageSetup.TopMargin = InchesToPoints(1)

If sAction = "Insert" Then
'Go to the top of the document
Selection.HomeKey Unit:=wdStory

'Insert the logo
Set oRange = NormalTemplate.BuildingBlockEntries("logo for Email").Insert(Selection.Range)

'Name the logo so it can be found during deletion
oRange.ShapeRange.Name = "logo for Email"
End If
Exit Sub

InsertLogo:
If sAction = "Delete" Then
sAction = "Insert"
Resume Next
Else
MsgBox ("Unable to insert logo. Please contact IT for assistance")
End If

End Sub

[macropod]

Hi GreatBarrier,

The code portion you posted is efficient enough, especially given that's its not doing anything intensive.

You say it's intended to insert a logo. From my reading of the code, it's actually replacing a logo. I'd be inclined to approach the task differently. What I'd do is insert into the template an INCLUDEPICTURE field, pointing to the logo file on disk. Then, whenever a new document is created from the template, simply update then unlink the field. That way, the logo need never be stored in the template and, if there's a need to change the logo, all you need to do is to replace the copy on disk.

[OTWarrior]

well the code seems to always want to out the image in, which is rather odd.

if there is no image add one, if there is an image delete it and add one.

I wonder does the image actually need to be replaced when this code runs (is it a different image?)

If it doesn't, then you can change the code to simply add an image.


Code untested:

Dim oRange As Object
On Error GoTo InsertLogo

'Set top margin to 2
ActiveDocument.PageSetup.TopMargin = InchesToPoints(1)
'Go to the top of the document
Selection.HomeKey Unit:=wdStory
'Insert the logo
Set oRange = NormalTemplate.BuildingBlockEntries("logo for Email").Insert(Selection.Range)
'Name the logo so it can be found during deletion
oRange.ShapeRange.Name = "logo for Email"

Exit Sub

InsertLogo:
MsgBox ("Unable to insert logo. Please contact IT for assistance")
End Sub

[GreatBarrier]

The idea was that it was a Macro that was run when you pressed Ctrl-L. It adds our company letterhead when those keystrokes are pressed.

The first press would add in the logo, and the press after would remove it.

Does that make more sense?

I was thinking i could check to see if the logo existed already, and if so, remove it. Else, just add it. Can that be done?

[OTWarrior]

Ah, I understand now. Try this (not tested):

Public Sub logothingy()
Dim oRange As Object
Dim sAction As String

On Error GoTo Error1
sAction = "Delete"
ActiveDocument.Shapes("logo for Email").Delete

ActiveDocument.PageSetup.TopMargin = InchesToPoints(1)

Insert:
sAction = "Insert"
Selection.HomeKey Unit:=wdStory
Set oRange = NormalTemplate.BuildingBlockEntries("logo for Email").Insert(Selection.Range)
oRange.ShapeRange.Name = "logo for Email"
Exit Sub

Error1:
If sAction = "Delete" Then
GoTo Insert
Else
MsgBox ("Unable to insert logo. Please contact IT for assistance")
End If
End Sub

[GreatBarrier]

Ah, I understand now. Try this (not tested):

Public Sub logothingy()
Dim oRange As Object
Dim sAction As String

On Error GoTo Error1
sAction = "Delete"
ActiveDocument.Shapes("logo for Email").Delete

ActiveDocument.PageSetup.TopMargin = InchesToPoints(1)

Insert:
sAction = "Insert"
Selection.HomeKey Unit:=wdStory
Set oRange = NormalTemplate.BuildingBlockEntries("logo for Email").Insert(Selection.Range)
oRange.ShapeRange.Name = "logo for Email"
Exit Sub

Error1:
If sAction = "Delete" Then
GoTo Insert
Else
MsgBox ("Unable to insert logo. Please contact IT for assistance")
End If
End Sub

thanks, i will test it. Is there a way to see if the picture exists in the current doc, and if so, just delete it?

[OTWarrior]

Sure, just add exit sub after the delete function:

Public Sub logothingy()
Dim oRange As Object
Dim sAction As String

On Error GoTo Error1
sAction = "Delete"
ActiveDocument.Shapes("logo for Email").Delete
Exit Sub

ActiveDocument.PageSetup.TopMargin = InchesToPoints(1)

Insert:
sAction = "Insert"
Selection.HomeKey Unit:=wdStory
Set oRange = NormalTemplate.BuildingBlockEntries("logo for Email").Insert(Selection.Range)
oRange.ShapeRange.Name = "logo for Email"
Exit Sub

Error1:
If sAction = "Delete" Then
GoTo Insert
Else
MsgBox ("Unable to insert logo. Please contact IT for assistance")
End If
End Sub

[GreatBarrier]

I dont understand how that is different. Is there actually not a way to do

if Picture exists
{
do this
}

[OTWarrior]

It does anyway, as the code cannot delete an object that isn't there so throws an error.

By adding the exit after the delete code it will only delete the picture.
If the image doesn't exist it goes STRAIGHT to Error1, and since it will be in delete mode, it will go to the insert code.

follow the code through when you run it in both situations with breakpoints and you will see what I mean

[macropod]

GreatBarrier,

I get the impression you're just trying to show up "my moron of a ex-boss". See:
http://forums.microsoft.com/msdn/ShowPost.aspx?PostID=3657825&SiteID=1
I don't think that's what this forum, or the MSDN one is about. You also claim the code you posted was "written 7 years ago". That's completely false. BuildingBlockEntries didn't exist then. AFAIK, they only came into existence with Word 2007.

FWIW I think you could use the following, but I don't have access to Word 2007 to test it:
Sub LogoManager()
Dim oRange As Object
With ActiveDocument
If .ProtectionType = wdNoProtection Then
On Error GoTo Insert
.Shapes("logo for Email").Delete
Exit Sub
Insert:
.PageSetup.TopMargin = InchesToPoints(1)
On Error GoTo Failed
Set oRange = NormalTemplate.BuildingBlockEntries("logo for Email").Insert(.Range.Collapse(wdCollapseStart))
oRange.ShapeRange.Name = "logo for Email"
Exit Sub
Failed:
MsgBox ("Unable to insert logo. Please contact IT for assistance")
Else
MsgBox ("Protected Document - Unable to insert logo.")
End If
End With
End SubNote that I've added an extra test to check whether the document is protected.

[GreatBarrier]

I resent the implication that i'm trying to show that up.

I had to revamp the older code for the reason you stated, BuildingBlocks didnt exist pre-2k7. But since i was only working on 2k7, i thought i would only post that.

Here is the pre-2k7 code. Thanks for everyone's help.


Set oRange = NormalTemplate.AutoTextEntries("CIA Logo for e-mail").Insert(Selection.Range)