cookieboy66
08-08-2009, 05:01 PM
I've written some code to add a custom menu to MS Word with a whole lot of frequently used templates. This was working fine but some of the templates were updated and the filenames changed. So I updated the code that adds the menu (and added some additional templates), only now when I open Word the old menu is there. The code for the menu was taken from another website and adapted to suit. Can anyone help me change the code so that the menu stays consistent.
I've saved the file with the code as a template and put it in the start up folder so it runs as an add in.
The code is:
Sub AddMenuBar()
Dim Mybar As CommandBar
Dim cmd As CommandBarPopup
Dim i As Integer
Dim A(35) As Variant
Dim myButton
CustomizationContext = Application.NormalTemplate
' CustomizationContext = ActiveDocument.AttachedTemplate
On Error Resume Next
CommandBars("Menu Bar").Controls("C&ooke").Delete
'Note that the parts of the array are ("Title of menu option","Macro to Run", FaceID for toolbar button)
A(1) = Array("Print to PDF", "PDF", 4)
A(2) = Array("Insert Header/Footer", "Header_footer", 237)
A(3) = Array("Works Instruction", "Works_Instruction", 102)
A(4) = Array("Insert Signature", "Insert_Signature", 593)
A(5) = Array("Company Memo", "CompanyMemo", 5765)
A(6) = Array("Report", "Report", 2042)
A(7) = Array("Mechanical Services Maintenance Proposal", "Mech_Serv_Maint_Proposal", 548)
A(8) = Array("Acoustic door quote", "Acoustic_door_quote", 0)
A(9) = Array("Aerco quote", "Aerco_quote", 0)
A(10) = Array("AHU quote", "AHU_quote", 0)
A(11) = Array("Boiler quote - Ambassador", "Ambassador_Boiler_quote", 0)
A(12) = Array("Boiler quote - ICI Caldaie", "ICI_Boiler_quote", 0)
A(13) = Array("Boiler quote - Unical ", "Unical_Boiler_quote", 0)
A(14) = Array("Calorifier quote - Britannia", "Britannia_Calorifier_Quote", 0)
A(15) = Array("Calorifier quote", "Calorifier_Quote", 0)
A(16) = Array("Clivet chiller quote", "Clivet_chiller_quote", 0)
A(17) = Array("Coil quote", "Coil_quote", 0)
A(18) = Array("Cooling tower quote", "Cooling_Tower_quote", 0)
A(19) = Array("Damper/louvre quote", "Damper_louvre_quote", 0)
A(20) = Array("Diffuser quote", "Diffuser_quote", 0)
A(21) = Array("Dry cooler quote", "Dry_cooler_quote", 0)
A(22) = Array("Duct quote", "Duct_quote", 0)
A(23) = Array("Expansion tank quote", "Expansion_tank_quote", 0)
A(24) = Array("Fan quote", "Fan_quote", 0)
A(25) = Array("FCU quote", "FCU_quote", 0)
A(26) = Array("Flue quote", "Flue_quote", 0)
A(27) = Array("Gas fired heater quote", "Gas_fired_heater_quote", 0)
A(28) = Array("Humidifier quote", "Humidifier_quote", 0)
A(29) = Array("Plate heat exchanger quote", "Plate_heat_exch_quote", 0)
A(30) = Array("Pump quote", "Pump_quote", 0)
A(31) = Array("Recuperator quote", "Recuperator_quote", 0)
A(32) = Array("Refrigeration vessel quote", "Refrigeration_vessel_quote", 0)
A(33) = Array("Silencer quote", "Silencer_quote", 0)
A(34) = Array("Tank quote", "Tank_quote", 0)
A(35) = Array("VAV quote", "VAV_quote", 0)
With CommandBars("Menu Bar").Controls
.Add(Type:=msoControlPopup, Before:=9).Caption = "C&ooke"
End With
For i = 1 To UBound(A)
With CommandBars("Menu Bar").Controls("C&ooke").Controls
Set myButton = .Add(Type:=msoControlButton)
With myButton
.Caption = A(i)(0)
.OnAction = A(i)(1)
.FaceId = A(i)(2)
End With
End With
Next i
End Sub
Private Sub Acoustic_door_quote()
'
' Starts a new Acoustic door quote document
Application.ScreenUpdating = False
Documents.Add Template:="P:\Templates\WkTempl\Quote_Acoustic_door.dot"
Application.ScreenUpdating = True
End Sub
Private Sub Cooling_Tower_quote()
'
' Starts a new Cooling tower quote document
Application.ScreenUpdating = False
Documents.Add Template:="P:\Templates\WkTempl\Quote_Cooling Tower.dot"
Application.ScreenUpdating = True
End Sub
Private Sub Damper_louvre_quote()
'
' Starts a new damper/louvre quote document
Application.ScreenUpdating = False
Documents.Add Template:="P:\Templates\WkTempl\Quote_Damper & Louvre.dot "
Application.ScreenUpdating = True
End Sub
Private Sub Diffuser_quote()
'
' Starts a new Diffuser quote document
Application.ScreenUpdating = False
Documents.Add Template:="P:\Templates\WkTempl\Quote_Diffusers.dot"
Application.ScreenUpdating = True
End Sub
Private Sub Dry_Cooler_quote()
'
' Starts a new Dry Cooler quote document
Application.ScreenUpdating = False
Documents.Add Template:="P:\Templates\WkTempl\Quote_Dry Cooler.dot"
Application.ScreenUpdating = True
End Sub
Sub PDF()
'
' PDF Macro
' Prints document as a PDF then returns your print device to the user's default printer
'
Dim UserPrinter As String
Application.ScreenUpdating = False
On Error Resume Next
UserPrinter = Application.ActivePrinter
ActivePrinter = "PDF995"
Application.PrintOut FileName:=""
ActivePrinter = UserPrinter
End Sub
Sub InsertSignature()
'
' Inserts the users signature into a document
'
Dim strPath As String
Dim strInitials As String
Dim strSignaturePath As String
On Error GoTo errtrap
Application.ScreenUpdating = False
strPath = "C:\Documents and Settings\" & Environ$("Username") & "\"
strInitials = Application.UserInitials & " signature.jpg"
strSignaturePath = strPath & strInitials
Selection.InlineShapes.AddPicture _
FileName:=strSignaturePath, _
LinkToFile:=False, SaveWithDocument:=True
Application.ScreenUpdating = True
errtrap:
On Error Resume Next
End Sub
Private Sub Mech_Serv_Maint_Proposal()
'
'Starts a new mechanical services maintenance proposal
Application.ScreenUpdating = False
Documents.Add Template:="P:\Templates\WkTempl\Mechanical Services Maintenance Proposal.dot "
Application.ScreenUpdating = True
End Sub
I've saved the file with the code as a template and put it in the start up folder so it runs as an add in.
The code is:
Sub AddMenuBar()
Dim Mybar As CommandBar
Dim cmd As CommandBarPopup
Dim i As Integer
Dim A(35) As Variant
Dim myButton
CustomizationContext = Application.NormalTemplate
' CustomizationContext = ActiveDocument.AttachedTemplate
On Error Resume Next
CommandBars("Menu Bar").Controls("C&ooke").Delete
'Note that the parts of the array are ("Title of menu option","Macro to Run", FaceID for toolbar button)
A(1) = Array("Print to PDF", "PDF", 4)
A(2) = Array("Insert Header/Footer", "Header_footer", 237)
A(3) = Array("Works Instruction", "Works_Instruction", 102)
A(4) = Array("Insert Signature", "Insert_Signature", 593)
A(5) = Array("Company Memo", "CompanyMemo", 5765)
A(6) = Array("Report", "Report", 2042)
A(7) = Array("Mechanical Services Maintenance Proposal", "Mech_Serv_Maint_Proposal", 548)
A(8) = Array("Acoustic door quote", "Acoustic_door_quote", 0)
A(9) = Array("Aerco quote", "Aerco_quote", 0)
A(10) = Array("AHU quote", "AHU_quote", 0)
A(11) = Array("Boiler quote - Ambassador", "Ambassador_Boiler_quote", 0)
A(12) = Array("Boiler quote - ICI Caldaie", "ICI_Boiler_quote", 0)
A(13) = Array("Boiler quote - Unical ", "Unical_Boiler_quote", 0)
A(14) = Array("Calorifier quote - Britannia", "Britannia_Calorifier_Quote", 0)
A(15) = Array("Calorifier quote", "Calorifier_Quote", 0)
A(16) = Array("Clivet chiller quote", "Clivet_chiller_quote", 0)
A(17) = Array("Coil quote", "Coil_quote", 0)
A(18) = Array("Cooling tower quote", "Cooling_Tower_quote", 0)
A(19) = Array("Damper/louvre quote", "Damper_louvre_quote", 0)
A(20) = Array("Diffuser quote", "Diffuser_quote", 0)
A(21) = Array("Dry cooler quote", "Dry_cooler_quote", 0)
A(22) = Array("Duct quote", "Duct_quote", 0)
A(23) = Array("Expansion tank quote", "Expansion_tank_quote", 0)
A(24) = Array("Fan quote", "Fan_quote", 0)
A(25) = Array("FCU quote", "FCU_quote", 0)
A(26) = Array("Flue quote", "Flue_quote", 0)
A(27) = Array("Gas fired heater quote", "Gas_fired_heater_quote", 0)
A(28) = Array("Humidifier quote", "Humidifier_quote", 0)
A(29) = Array("Plate heat exchanger quote", "Plate_heat_exch_quote", 0)
A(30) = Array("Pump quote", "Pump_quote", 0)
A(31) = Array("Recuperator quote", "Recuperator_quote", 0)
A(32) = Array("Refrigeration vessel quote", "Refrigeration_vessel_quote", 0)
A(33) = Array("Silencer quote", "Silencer_quote", 0)
A(34) = Array("Tank quote", "Tank_quote", 0)
A(35) = Array("VAV quote", "VAV_quote", 0)
With CommandBars("Menu Bar").Controls
.Add(Type:=msoControlPopup, Before:=9).Caption = "C&ooke"
End With
For i = 1 To UBound(A)
With CommandBars("Menu Bar").Controls("C&ooke").Controls
Set myButton = .Add(Type:=msoControlButton)
With myButton
.Caption = A(i)(0)
.OnAction = A(i)(1)
.FaceId = A(i)(2)
End With
End With
Next i
End Sub
Private Sub Acoustic_door_quote()
'
' Starts a new Acoustic door quote document
Application.ScreenUpdating = False
Documents.Add Template:="P:\Templates\WkTempl\Quote_Acoustic_door.dot"
Application.ScreenUpdating = True
End Sub
Private Sub Cooling_Tower_quote()
'
' Starts a new Cooling tower quote document
Application.ScreenUpdating = False
Documents.Add Template:="P:\Templates\WkTempl\Quote_Cooling Tower.dot"
Application.ScreenUpdating = True
End Sub
Private Sub Damper_louvre_quote()
'
' Starts a new damper/louvre quote document
Application.ScreenUpdating = False
Documents.Add Template:="P:\Templates\WkTempl\Quote_Damper & Louvre.dot "
Application.ScreenUpdating = True
End Sub
Private Sub Diffuser_quote()
'
' Starts a new Diffuser quote document
Application.ScreenUpdating = False
Documents.Add Template:="P:\Templates\WkTempl\Quote_Diffusers.dot"
Application.ScreenUpdating = True
End Sub
Private Sub Dry_Cooler_quote()
'
' Starts a new Dry Cooler quote document
Application.ScreenUpdating = False
Documents.Add Template:="P:\Templates\WkTempl\Quote_Dry Cooler.dot"
Application.ScreenUpdating = True
End Sub
Sub PDF()
'
' PDF Macro
' Prints document as a PDF then returns your print device to the user's default printer
'
Dim UserPrinter As String
Application.ScreenUpdating = False
On Error Resume Next
UserPrinter = Application.ActivePrinter
ActivePrinter = "PDF995"
Application.PrintOut FileName:=""
ActivePrinter = UserPrinter
End Sub
Sub InsertSignature()
'
' Inserts the users signature into a document
'
Dim strPath As String
Dim strInitials As String
Dim strSignaturePath As String
On Error GoTo errtrap
Application.ScreenUpdating = False
strPath = "C:\Documents and Settings\" & Environ$("Username") & "\"
strInitials = Application.UserInitials & " signature.jpg"
strSignaturePath = strPath & strInitials
Selection.InlineShapes.AddPicture _
FileName:=strSignaturePath, _
LinkToFile:=False, SaveWithDocument:=True
Application.ScreenUpdating = True
errtrap:
On Error Resume Next
End Sub
Private Sub Mech_Serv_Maint_Proposal()
'
'Starts a new mechanical services maintenance proposal
Application.ScreenUpdating = False
Documents.Add Template:="P:\Templates\WkTempl\Mechanical Services Maintenance Proposal.dot "
Application.ScreenUpdating = True
End Sub