Sub 插入图片()
'设置页边距
Dim myfile As FileDialog
With Selection.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(2)
.BottomMargin = CentimetersToPoints(2)
.LeftMargin = CentimetersToPoints(2.54)
.RightMargin = CentimetersToPoints(2)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.5)
.FooterDistance = CentimetersToPoints(0.8)
.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
ActiveDocument.Styles.Add Name:="样式 2",Type:=wdStyleTypeParagraph
ActiveDocument.Styles("样式 2").AutomaticallyUpdate =False
ActiveDocument.Styles.Add Name:="样式 3",Type:=wdStyleTypeParagraph
ActiveDocument.Styles("样式 3").AutomaticallyUpdate =False
'设置标题样式
With ActiveDocument.Styles("样式 2").Font
.NameFarEast = "宋体"
.NameAscii = "Times New Roman"
.NameOther = "Times New Roman"
.Name = "Times New Roman"
.Size = 12
.Bold = True
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Scaling = 100
.Kerning = 0
.Animation = wdAnimationNone
.DisableCharacterSpaceGrid = False
.EmphasisMark = wdEmphasisMarkNone
.Ligatures = wdLigaturesNone
.NumberSpacing = wdNumberSpacingDefault
.NumberForm = wdNumberFormDefault
.StylisticSet = wdStylisticSetDefault
.ContextualAlternates = 0
End With
With ActiveDocument.Styles("样式 2").ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphCenter
.WidowControl = False
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevel2
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.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
ActiveDocument.Styles("样式2").NoSpaceBetweenParagraphsOfSameStyle = False
With ActiveDocument.Styles("样式 2")
.AutomaticallyUpdate = False
.BaseStyle = "正文"
.NextParagraphStyle = "正文"
End With
'设置标题样式
With ActiveDocument.Styles("样式 3").Font
.NameFarEast = "宋体"
.NameAscii = "Times New Roman"
.NameOther = "Times New Roman"
.Name = "Times New Roman"
.Size = 12
.Bold = True
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Scaling = 100
.Kerning = 0
.Animation = wdAnimationNone
.DisableCharacterSpaceGrid = False
.EmphasisMark = wdEmphasisMarkNone
.Ligatures = wdLigaturesNone
.NumberSpacing = wdNumberSpacingDefault
.NumberForm = wdNumberFormDefault
.StylisticSet = wdStylisticSetDefault
.ContextualAlternates = 0
End With
With ActiveDocument.Styles("样式 3").ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphCenter
.WidowControl = False
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevel3
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.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
ActiveDocument.Styles("样式3").NoSpaceBetweenParagraphsOfSameStyle = False
With ActiveDocument.Styles("样式 3")
.AutomaticallyUpdate = False
.BaseStyle = "正文"
.NextParagraphStyle = "正文"
End With
'插入图谱
'Z = InputBox("请输入插入图片的宽度：", "厘米单位", 18) * 28.35
'获取图谱路径
Set myfile =Application.FileDialog(msoFileDialogFilePicker)
With myfile
.InitialFileName = "E:\"
If .Show = -1 Then
For Each fn In .SelectedItems
Set mypic =Selection.InlineShapes.AddPicture(FileName:=fn, SaveWithDocument:=True)
pw1 = mypic.Width
ph1 = mypic.Height
mypic.Width = 16.4*28.35
mypic.Height = 24*28.35
Selection.ParagraphFormat.Alignment =wdAlignParagraphCenter
If Selection.Start = ActiveDocument.Content.End - 1Then '如光标在文末
Selection.TypeParagraph '在文末添加一空段
Else
Selection.MoveDown
End If
Selection.Text = Basename(fn) '函数取得文件名
Selection.EndKey
Selection.Style = ActiveDocument.Styles("样式 3")
If Selection.Start = ActiveDocument.Content.End - 1Then '如光标在文末
Selection.TypeParagraph '在文末添加一空段
Else
Selection.MoveDown
End If
Next fn
Else
End If
End With
'插入目录
Selection.HomeKey Unit:=wdStory '移动光标到文档开始
Selection.TypeText Text:="目录" '输入目录
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter'居中
With ActiveDocument '添加目录
.TablesOfContents.Add Range:=Selection.Range,RightAlignPageNumbers:= _
True, UseHeadingStyles:=True, UpperHeadingLevel:=3,_
LowerHeadingLevel:=3, IncludePageNumbers:=True,AddedStyles:="", _
UseHyperlinks:=True, HidePageNumbersInWeb:=True,UseOutlineLevels:= _
True
.TablesOfContents(1).TabLeader = wdTabLeaderDots
.TablesOfContents.Format = wdIndexIndent
End With
Selection.InsertBreak Type:=wdSectionBreakNextPage'目录后插入分节符
Selection.MoveUp Unit:=wdLine, Count:=1 '选中目录页
'设置目录页边距为普通
With Selection.PageSetup '设置目录页边距为普通
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(2)
.BottomMargin = CentimetersToPoints(2)
.LeftMargin = CentimetersToPoints(2.54)
.RightMargin = CentimetersToPoints(2)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.5)
.FooterDistance = CentimetersToPoints(0.8)
.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
'替换目录的页码
ym = InputBox("请输入页码格式：", , "3.2.S.4附件6")
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = vbTab
.Replacement.Text = vbTab & ym &"-"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'将原目录替换为文件名，并设置为标题1
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style =ActiveDocument.Styles("样式 2")
With Selection.Find
.Text ="目录"
.Replacement.Text = ym
.Forward= True
.Wrap =wdFindContinue
.Format =True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'设置全文档字体格式
Selection.WholeStory '全选
Selection.Font.Name = "宋体"
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 12
Set myfile = Nothing
End Sub
Function Basename(FullPath) '取得文件名
Basename =Left(CreateObject("Scripting.FileSystemObject").getfile(FullPath).Name,InStr(CreateObject("Scripting.FileSystemObject").getfile(FullPath).Name,".") - 1)
End Function
'设置页边距
Dim myfile As FileDialog
With Selection.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(2)
.BottomMargin = CentimetersToPoints(2)
.LeftMargin = CentimetersToPoints(2.54)
.RightMargin = CentimetersToPoints(2)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.5)
.FooterDistance = CentimetersToPoints(0.8)
.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
ActiveDocument.Styles.Add Name:="样式 2",Type:=wdStyleTypeParagraph
ActiveDocument.Styles("样式 2").AutomaticallyUpdate =False
ActiveDocument.Styles.Add Name:="样式 3",Type:=wdStyleTypeParagraph
ActiveDocument.Styles("样式 3").AutomaticallyUpdate =False
'设置标题样式
With ActiveDocument.Styles("样式 2").Font
.NameFarEast = "宋体"
.NameAscii = "Times New Roman"
.NameOther = "Times New Roman"
.Name = "Times New Roman"
.Size = 12
.Bold = True
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Scaling = 100
.Kerning = 0
.Animation = wdAnimationNone
.DisableCharacterSpaceGrid = False
.EmphasisMark = wdEmphasisMarkNone
.Ligatures = wdLigaturesNone
.NumberSpacing = wdNumberSpacingDefault
.NumberForm = wdNumberFormDefault
.StylisticSet = wdStylisticSetDefault
.ContextualAlternates = 0
End With
With ActiveDocument.Styles("样式 2").ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphCenter
.WidowControl = False
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevel2
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.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
ActiveDocument.Styles("样式2").NoSpaceBetweenParagraphsOfSameStyle = False
With ActiveDocument.Styles("样式 2")
.AutomaticallyUpdate = False
.BaseStyle = "正文"
.NextParagraphStyle = "正文"
End With
'设置标题样式
With ActiveDocument.Styles("样式 3").Font
.NameFarEast = "宋体"
.NameAscii = "Times New Roman"
.NameOther = "Times New Roman"
.Name = "Times New Roman"
.Size = 12
.Bold = True
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Scaling = 100
.Kerning = 0
.Animation = wdAnimationNone
.DisableCharacterSpaceGrid = False
.EmphasisMark = wdEmphasisMarkNone
.Ligatures = wdLigaturesNone
.NumberSpacing = wdNumberSpacingDefault
.NumberForm = wdNumberFormDefault
.StylisticSet = wdStylisticSetDefault
.ContextualAlternates = 0
End With
With ActiveDocument.Styles("样式 3").ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphCenter
.WidowControl = False
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevel3
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.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
ActiveDocument.Styles("样式3").NoSpaceBetweenParagraphsOfSameStyle = False
With ActiveDocument.Styles("样式 3")
.AutomaticallyUpdate = False
.BaseStyle = "正文"
.NextParagraphStyle = "正文"
End With
'插入图谱
'Z = InputBox("请输入插入图片的宽度：", "厘米单位", 18) * 28.35
'获取图谱路径
Set myfile =Application.FileDialog(msoFileDialogFilePicker)
With myfile
.InitialFileName = "E:\"
If .Show = -1 Then
For Each fn In .SelectedItems
Set mypic =Selection.InlineShapes.AddPicture(FileName:=fn, SaveWithDocument:=True)
pw1 = mypic.Width
ph1 = mypic.Height
mypic.Width = 16.4*28.35
mypic.Height = 24*28.35
Selection.ParagraphFormat.Alignment =wdAlignParagraphCenter
If Selection.Start = ActiveDocument.Content.End - 1Then '如光标在文末
Selection.TypeParagraph '在文末添加一空段
Else
Selection.MoveDown
End If
Selection.Text = Basename(fn) '函数取得文件名
Selection.EndKey
Selection.Style = ActiveDocument.Styles("样式 3")
If Selection.Start = ActiveDocument.Content.End - 1Then '如光标在文末
Selection.TypeParagraph '在文末添加一空段
Else
Selection.MoveDown
End If
Next fn
Else
End If
End With
'插入目录
Selection.HomeKey Unit:=wdStory '移动光标到文档开始
Selection.TypeText Text:="目录" '输入目录
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter'居中
With ActiveDocument '添加目录
.TablesOfContents.Add Range:=Selection.Range,RightAlignPageNumbers:= _
True, UseHeadingStyles:=True, UpperHeadingLevel:=3,_
LowerHeadingLevel:=3, IncludePageNumbers:=True,AddedStyles:="", _
UseHyperlinks:=True, HidePageNumbersInWeb:=True,UseOutlineLevels:= _
True
.TablesOfContents(1).TabLeader = wdTabLeaderDots
.TablesOfContents.Format = wdIndexIndent
End With
Selection.InsertBreak Type:=wdSectionBreakNextPage'目录后插入分节符
Selection.MoveUp Unit:=wdLine, Count:=1 '选中目录页
'设置目录页边距为普通
With Selection.PageSetup '设置目录页边距为普通
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(2)
.BottomMargin = CentimetersToPoints(2)
.LeftMargin = CentimetersToPoints(2.54)
.RightMargin = CentimetersToPoints(2)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.5)
.FooterDistance = CentimetersToPoints(0.8)
.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
'替换目录的页码
ym = InputBox("请输入页码格式：", , "3.2.S.4附件6")
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = vbTab
.Replacement.Text = vbTab & ym &"-"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'将原目录替换为文件名，并设置为标题1
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style =ActiveDocument.Styles("样式 2")
With Selection.Find
.Text ="目录"
.Replacement.Text = ym
.Forward= True
.Wrap =wdFindContinue
.Format =True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'设置全文档字体格式
Selection.WholeStory '全选
Selection.Font.Name = "宋体"
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 12
Set myfile = Nothing
End Sub
Function Basename(FullPath) '取得文件名
Basename =Left(CreateObject("Scripting.FileSystemObject").getfile(FullPath).Name,InStr(CreateObject("Scripting.FileSystemObject").getfile(FullPath).Name,".") - 1)
End Function
