WORD VBA 办公助手

Sub 设置页面()
'
' 设置页面和页码 宏
'
'
    With Selection.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = CentimetersToPoints(2.54)
        .BottomMargin = CentimetersToPoints(2.54)
        .LeftMargin = CentimetersToPoints(1.9)
        .RightMargin = CentimetersToPoints(1.9)
        .Gutter = CentimetersToPoints(0)
        .HeaderDistance = CentimetersToPoints(1.5)
        .FooterDistance = CentimetersToPoints(1.75)
        .PageWidth = CentimetersToPoints(21)
        .PageHeight = CentimetersToPoints(29.7)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
        .LinesPage = 44
        .LayoutMode = wdLayoutModeLineGrid
    End With
    
End Sub

Sub 插入页码()

ActiveDocument.PageSetup.OddAndEvenPagesHeaderFooter = False '关闭奇偶页相同（防止上回启用奇偶页不同后没有关闭此项设置）

With ActiveWindow.ActivePane.View

.SeekView = wdSeekCurrentPageFooter

With Selection

.Expand wdStory

.Font.Size = 9 '字号（小五）

.Font.Name = "楷书" '字体

.ParagraphFormat.Alignment = wdAlignParagraphCenter

.TypeText "第"
.Font.Name = "Times New Roman" '字体
.Fields.Add .Range, wdFieldPage
.Font.Name = "楷书" '字体
.TypeText "页 共"
.Font.Name = "Times New Roman" '字体
.Fields.Add .Range, wdFieldNumPages
.Font.Name = "楷书" '字体
.TypeText "页"
.ParagraphFormat.Alignment = wdAlignParagraphCenter '页码的位置居右

End With

.SeekView = wdSeekMainDocument '退出页码的编辑（即关闭页眉和页脚工具栏）

End With

End Sub
Sub InsertFileNameOnly()
    Dim xPathName As String
    Dim xDotPos As Integer
    With Application.ActiveDocument
        If Len(.Path) = 0 Then .Save
        xDotPos = VBA.InStrRev(.Name, ".")
        xPathName = VBA.Left(.Name, xDotPos - 1)
    End With
    Application.Selection.TypeText xPathName
End Sub
Sub 设置行间距和字体()
'
' 设置行间距和字体 宏
'
    
    Selection.WholeStory
    Selection.Font.Size = 10
    Selection.Font.Name = "宋体"
    Selection.Font.Name = "Times New Roman"
    With Selection.ParagraphFormat
        .LeftIndent = CentimetersToPoints(0)
        .RightIndent = CentimetersToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceMultiple
        .LineSpacing = LinesToPoints(1.2)
        .Alignment = wdAlignParagraphJustify
        .WidowControl = False
        .KeepWithNext = False
        .KeepTogether = False
        .PageBreakBefore = False
        .NoLineNumber = False
        .Hyphenation = True
        .FirstLineIndent = CentimetersToPoints(0.35)
        .OutlineLevel = wdOutlineLevelBodyText
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 2
        .LineUnitBefore = 0
        .LineUnitAfter = 0
        .MirrorIndents = False
        .TextboxTightWrap = wdTightNone
        .CollapsedByDefault = False
        .AutoAdjustRightIndent = True
        .DisableLineHeightGrid = False
        .FarEastLineBreakControl = True
        .WordWrap = True
        .HangingPunctuation = True
        .HalfWidthPunctuationOnTopOfLine = False
        .AddSpaceBetweenFarEastAndAlpha = True
        .AddSpaceBetweenFarEastAndDigit = True
        .BaseLineAlignment = wdBaselineAlignAuto
        
    End With
   Selection.MoveUp
     Dim xPathName As String
    Dim xDotPos As Integer
    With Application.ActiveDocument
        If Len(.Path) = 0 Then .Save
        xDotPos = VBA.InStrRev(.Name, ".")
        xPathName = VBA.Left(.Name, xDotPos - 1)
    End With
    Application.Selection.TypeText xPathName
    Selection.TypeParagraph
    
   With ActiveDocument.Paragraphs(1).Range.Font
   
   
   .Size = 30
   .Name = "黑体"
   .Name = "Times New Roman"
    .Alignment = wdAlignParagraphCenter
   End With
   
End Sub
Sub 另存为PDF()
 MsgBox ActiveDocument.Path & "\" & Split(ActiveDocument.Name, ".")(0)
 
 ActiveDocument.SaveAs2 ActiveDocument.Path & "\" & Split(ActiveDocument.Name, ".")(0), 17
End Sub