PDA

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



GreatBarrier
07-23-2008, 01:44 PM
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

OTWarrior
07-24-2008, 02:15 AM
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
07-24-2008, 04:58 AM
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
07-24-2008, 06:48 AM
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
07-24-2008, 07:46 AM
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
07-24-2008, 08:53 AM
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
07-24-2008, 11:48 AM
I dont understand how that is different. Is there actually not a way to do

if Picture exists
{
do this
}

OTWarrior
07-25-2008, 12:00 AM
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