Private Sub Document_Open()
Dim Mybar As CommandBar
Dim cmd As CommandBarPopup
Dim i As Integer
Dim A(12) As Variant
CustomizationContext = ActiveDocument.AttachedTemplate
On Error Resume Next
CommandBars("Menu Bar").Controls("Te&mplates").Caption = "Te&mplates"
If Not Err.Number = 0 Then
A(1) = Array("Suat's Signature " , " Ozgur " , 92)
A(2) = Array("Anne's Signature " , " Smith " , 85)
A(3) = Array("Nancy's Signature " , " Johnson " , 89)
A(4) = Array("Dreamboat's Signature " , " Dreamboat " , 80)
A(5) = Array("Mickey's Signature " , " Mouse " , 98)
A(6) = Array("Insert Photo", "InsPic", 280)
A(7) = Array("Fix Picture", "FixPix", 1363)
A(8) = Array("Add Photo Heading", "PhotoCont", 314)
A(9) = Array("Insert Stopping Point", "StopPoint", 2528)
A(10) = Array("Find Last Stopping Point", "StartHere", 2526)
A(11) = Array("Print Just This Page", "PrtPg", 159)
A(12) = Array("Insert Landscape Page", "InsertLand", 6)
With CommandBars("Menu Bar").Controls
.Add(Type:=msoControlPopup, Before:=11).Caption = "Te&mplates"
End With
For i = 1 To UBound(A)
With CommandBars("Menu Bar").Controls("Te&mplates").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
Else
End If
End Sub
Private Sub Document_Close()
On Error Resume Next
CommandBars("Menu Bar").Controls("Te&mplates").Delete ActiveDocument.AttachedTemplate.Saved = True
End Sub
Sub Ozgur()
Selection.TypeText Text:="Sincerely,"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Your Company Name Here"
Selection.Font.Bold = wdToggle
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="Suat Ozgur"
Selection.TypeParagraph
Selection.TypeText Text:="Excellent VBA Coder who Provided this Code!"
End Sub
Sub Smith()
Selection.TypeText Text:="Sincerely,"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Your Company Name Here"
Selection.Font.Bold = wdToggle
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="Anne Smith"
Selection.TypeParagraph
Selection.TypeText Text:="Certified Know-It-All"
End Sub
Sub Johnson()
Selection.TypeText Text:="Sincerely,"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Your Company Name Here"
Selection.Font.Bold = wdToggle
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="Nancy Johnson"
Selection.TypeParagraph
Selection.TypeText Text:="Certifiably Insane"
Selection.TypeParagraph
Selection.TypeText Text:="Vice President"
End Sub
Sub Dreamboat()
Selection.TypeText Text:="Sincerely,"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Your Company Name Here"
Selection.Font.Bold = wdToggle
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="Dreamboat"
Selection.TypeParagraph
Selection.TypeText Text:="www.VBAExpress.com"
End Sub
Sub Mouse()
Selection.TypeText Text:="Sincerely,"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Walt Disney World"
Selection.Font.Bold = wdToggle
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:="Mickey Mouse"
Selection.TypeParagraph
Selection.TypeText Text:="Entrepreneur"
End Sub
Sub Prtpg()
Application.PrintOut FileName:="", Range:=wdPrintCurrentPage, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:=""
End Sub
Sub PhotoCont()
Selection.TypeText Text:="Photographs of the Subject Property"
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Style = ActiveDocument.Styles("Normal")
Selection.Font.Size = 16
Selection.Font.Bold = wdToggle
With Selection.ParagraphFormat
.LeftIndent = InchesToPoints(0)
.RightIndent = InchesToPoints(0)
.SpaceBefore = 3
.SpaceBeforeAuto = False
.SpaceAfter = 3
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = InchesToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
Selection.EndKey Unit:=wdLine
End Sub
Sub FixPix()
Selection.InlineShapes(1).Fill.Visible = msoFalse
Selection.InlineShapes(1).Fill.Transparency = 0#
Selection.InlineShapes(1).Line.Weight = 0.75
Selection.InlineShapes(1).Line.Transparency = 0#
Selection.InlineShapes(1).Line.Visible = msoFalse
Selection.InlineShapes(1).LockAspectRatio = msoTrue
Selection.InlineShapes(1).Height = 246.94
Selection.InlineShapes(1).Width = 328.29
Selection.InlineShapes(1).PictureFormat.Brightness = 0.5
Selection.InlineShapes(1).PictureFormat.Contrast = 0.5
Selection.InlineShapes(1).PictureFormat.ColorType = msoPictureAutomatic
Selection.InlineShapes(1).PictureFormat.CropLeft = 0#
Selection.InlineShapes(1).PictureFormat.CropRight = 0#
Selection.InlineShapes(1).PictureFormat.CropTop = 0#
Selection.InlineShapes(1).PictureFormat.CropBottom = 0#
Selection.Style = ActiveDocument.Styles("Pictures")
End Sub
Sub StopPoint()
Selection.TypeText Text:="STOPHERE"
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Font.Color = wdColorRed
Selection.HomeKey Unit:=wdLine
End Sub
Sub StartHere()
Selection.Find.ClearFormatting
With Selection.Find
.Text = "stophere"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
End Sub
Sub InsertLand()
Selection.InsertBreak Type:=wdSectionBreakNextPage
Selection.InsertBreak Type:=wdSectionBreakNextPage
Selection.MoveUp Unit:=wdLine, Count:=1
With Selection.PageSetup
.Orientation = wdOrientLandscape
.TopMargin = InchesToPoints(1)
.BottomMargin = InchesToPoints(1.25)
.LeftMargin = InchesToPoints(1)
.RightMargin = InchesToPoints(1)
.Gutter = InchesToPoints(0)
.PageWidth = InchesToPoints(11)
.PageHeight = InchesToPoints(8.5)
.SectionStart = wdSectionNewPage
End With
Selection.TypeParagraph
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
End Sub
Sub InsPic()
Application.Dialogs(wdDialogInsertPicture).Show
End Sub
|