加载中…word用宏和VBA快速进行表格排版
(2015-10-04 21:55:04)
标签：
教育 |
分类： 幽默与智慧 |
最近因工作原因要处理4400多个表格，如何把这些表格统一格式，是个令人头痛的事情。尤其如果用手动调整表格，会不会累死呢。而且手动调节表格，各种表格大大小小很难做到统一划一，所以我只好用宏和VBA来对付出个快速排版的程序。里面漏洞很多，而且基本是半自动状态，但都能使用，至少把我400多个表格，转瞬之间就排好了版。
Dim mytable As
Table
Application.ScreenUpdating = False
For Each mytable In
ActiveDocument.Tables
'Selection.Style = ActiveDocument.Styles("普通表格")
'清除表格
'WordBasic.ClearTableStyle
mytable.Rows.WrapAroundText = False
'取消文字环绕
mytable.Range.Editors.Add wdEditorEveryone
'选中整个表格
mytable.AutoFitBehavior
(wdAutoFitWindow) '根据窗口调整内容
mytable.Rows.HeightRule = wdRowHeightAuto
'
mytable.Rows.Height =
CentimetersToPoints(0) '上下居中
mytable.Range.Cells(1).VerticalAlignment =
wdCellAlignVerticalCenter '垂直居中
With mytable
.TopPadding = CentimetersToPoints(0.08)
'上下间距=0.08，0.08
.BottomPadding = CentimetersToPoints(0.08) '
.LeftPadding = CentimetersToPoints(0.19) '左右间距0.19
.RightPadding = CentimetersToPoints(0.19) '
.Spacing = 0 ''取消固定行高
.AllowPageBreaks = True
'允许断行
.AllowAutoFit = True
'自动适应文字
End With
Next
ctiveDocument.SelectAllEditableRanges (wdEditorEveryone)
'选中全部表格区域
ActiveDocument.DeleteAllEditableRanges (wdEditorEveryone) '删除
Application.ScreenUpdating = True
Application.Run
MacroName:="select_alltables"
'///////////////////////////////////////////////////////////
Selection.Font.Size = 11
'设置字体
Selection.Font.name =
"仿宋"
'
////////////////////////////////////////////////////////////////////////
Selection.ParagraphFormat.LineSpacing =
LinesToPoints(1.3) '设置行距
'//////////////////////////////////////////////////////////////////////////
With Selection.Cells
'设置黑边框
With .Borders(wdBorderLeft)
.LineStyle
= wdLineStyleSingle
.LineWidth
= wdLineWidth150pt
.Color =
wdColorAutomatic
End With
With .Borders(wdBorderRight)
.LineStyle
= wdLineStyleSingle
.LineWidth
= wdLineWidth150pt
' .Color =
wdColorAutomatic
End With
With .Borders(wdBorderTop)
.LineStyle
= wdLineStyleSingle
.LineWidth
= wdLineWidth150pt
.Color =
wdColorAutomatic
End With
With .Borders(wdBorderBottom)
.LineStyle
= wdLineStyleSingle
.LineWidth
= wdLineWidth150pt
' .Color =
wdColorAutomatic
End With
With .Borders(wdBorderHorizontal)
.LineStyle
= wdLineStyleSingle
.LineWidth
= wdLineWidth075pt
.Color =
wdColorAutomatic
End With
With .Borders(wdBorderVertical)
.LineStyle
= wdLineStyleSingle
.LineWidth
= wdLineWidth075pt
.Color =
wdColorAutomatic
End With
'.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
'.Borders.Shadow = False
End
With
' With
Options
' .DefaultBorderLineStyle =
wdLineStyleSingle
' .DefaultBorderLineWidth =
wdLineWidth150pt
'.DefaultBorderColor = wdColorAutomatic
'End
With
'
mytable.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
'水平居中
'
mytable.Range.ParagraphFormat.Alignment = wdCellAlignVerticalCenter
'垂直居中
'mytable.Style = "test1"
'设置表格风格
Application.Run MacroName:="删除空白"
Application.Run MacroName:="取消底色"
'WordBasic.UpdateTableOfContents
Selection.Rows.Delete
Selection.MoveRight
Unit:=wdCharacter, count:=1
Selection.MoveUp
Unit:=wdLine, count:=2
Selection.MoveRight
Unit:=wdCharacter, count:=1
Selection.Tables(1).Rows.HeightRule = wdRowHeightAuto '
Selection.Tables(1).Rows.Height = CentimetersToPoints(0)
'上下居中
Selection.Range.Cells(1).VerticalAlignment =
wdCellAlignVerticalCenter '垂直居中
With
Selection.Tables(1)
.TopPadding = CentimetersToPoints(0.08)
'上下间距=0.08，0.08
.BottomPadding = CentimetersToPoints(0.08)
'
.LeftPadding = CentimetersToPoints(0.19)
'左右间距0.19
.RightPadding = CentimetersToPoints(0.19)
'
.Spacing = 0 ''取消固定行高
.AllowPageBreaks = Ture
'允许断行
.AllowAutoFit = True
'自动适应文字
End With
Selection.MoveDown
Unit:=wdParagraph, count:=3
Selection.Columns.Delete
Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
'Selection.MoveDown
Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.SelectCell
With
Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent =
CentimetersToPoints(0.56)
End With
With
Selection.ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceMultiple
.LineSpacing = LinesToPoints(1.3)
.Alignment = wdAlignParagraphJustify
.WidowControl = False
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent =
CentimetersToPoints(0.26)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 1.5
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
.AutoAdjustRightIndent = True
.DisableLineHeightGrid = False
.FarEastLineBreakControl = True
.WordWrap = True
.HangingPunctuation = True
.HalfWidthPunctuationOnTopOfLine = False
.AddSpaceBetweenFarEastAndAlpha = True
.AddSpaceBetweenFarEastAndDigit = True
.BaseLineAlignment = wdBaselineAlignAuto
End With
With Selection
MsgBox "Cell " &
.Information(wdStartOfRangeRowNumber) & "," &
.Information(wdStartOfRangeColumnNumber)
' MsgBox
Selection.Tables(1).Range.Start
End With
End If
Selection.Tables(1).Rows.Alignment = wdAlignRowLeft
Selection.Tables(1).Rows.WrapAroundText = False
Selection.WholeStory
Options.DefaultHighlightColorIndex = wdNoHighlight
Selection.Range.HighlightColorIndex = wdNoHighlight
Selection.HomeKey
Unit:=wdStory '光标移到文档开头
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With
Selection.Find
.Text = "^w"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With
Selection.Find
.Text = "^p^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With
Selection.Find
.Text = "^p^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Replace:=wdReplaceAll
Selection.Find.Execute
Replace:=wdReplaceAll
Selection.Find.Execute
Replace:=wdReplaceAll
Selection.SelectCell
Selection.Range.ListFormat.RemoveNumbers
NumberType:=wdNumberParagraph
With
ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
.NumberFormat = "%1."
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(0)
.Alignment = wdListLevelAlignLeft
.TextPosition = CentimetersToPoints(0.74)
.TabPosition = wdUndefined
.ResetOnHigher = 0
.StartAt = 1
With .Font
.Bold =
wdUndefined
.Italic =
wdUndefined
.StrikeThrough = wdUndefined
.Subscript
= wdUndefined
.Superscript = wdUndefined
.Shadow =
wdUndefined
.Outline =
wdUndefined
.Emboss =
wdUndefined
.Engrave =
wdUndefined
.AllCaps =
wdUndefined
.Hidden =
wdUndefined
.Underline
= wdUndefined
.Color =
wdUndefined
.Size =
wdUndefined
.Animation
= wdUndefined
.DoubleStrikeThrough = wdUndefined
.name =
""
End With
.LinkedStyle = ""
End With
ListGalleries(wdNumberGallery).ListTemplates(1).name = ""
Selection.Range.ListFormat.ApplyListTemplateWithLevel
ListTemplate:= _
ListGalleries(wdNumberGallery).ListTemplates(1),
ContinuePreviousList:= _
False, ApplyTo:=wdListApplyToSelection,
DefaultListBehavior:= _
wdWord10ListBehavior
Dim mytable As Table
Dim i As Integer, startTable As Integer, num
As Integer, endTable As Integer
Dim cellText As String
endTable = 26
'机构的数量,根据各区县进行手动修改
'///////////////////////////////////////////第13行
Set
mytable = ActiveDocument.Tables(j)
mytable.cell(13, 2).Select
cellText = Left(mytable.cell(13, 2).Range, 2)
If
cellText = "内容" Then
'mytable.cell(13, 1).Select
Application.Run ("填灰色")
Selection.Paste
End If
'////////////////////////////////////////////////////////////////第24行
mytable.cell(24, 2).Select
cellText = Left(mytable.cell(24, 2).Range,
2)
If cellText = "内容"
Then
' mytable.cell(24, 1).Select
Application.Run ("填灰色")
'Selection.Paste
End If
'///////////////////////////////////////第41行
mytable.cell(41, 2).Select
cellText = Left(mytable.cell(41, 2).Range,
2)
If cellText = "评定" Then
Application.Run ("填灰色")
End If
'///////////////////////////////////////////////////////////////
'对于项目来说，只有11行需要替换/
For j
= endTable To ActiveDocument.Tables.count
Set
mytable = ActiveDocument.Tables(j)
mytable.cell(11, 2).Select
cellText =
Left(mytable.cell(11, 2).Range, 2)
If
cellText = "内容" Then
Application.Run ("填灰色")
Selection.Paste
End If
Next
Selection.SelectRow
Selection.Shading.Texture = wdTextureNone
Selection.Shading.ForegroundPatternColor = wdColorAutomatic
Selection.Shading.BackgroundPatternColor = -570366209
Selection.InsertRowsAbove 1
Selection.SelectCell
Selection.TypeParagraph
Selection.TypeBackspace
Selection.MoveRight
Unit:=wdCharacter, count:=2, Extend:=wdExtend
Selection.Cells.Merge
Selection.TypeParagraph
Selection.TypeBackspace
Selection.Paste
Selection.SelectRow
Selection.Shading.Texture = wdTextureNone
Selection.Shading.ForegroundPatternColor = wdColorAutomatic
Selection.Shading.BackgroundPatternColor = -570366209
Selection.InsertRowsAbove 1
Selection.Paste
Dim mytable As Table
Dim i As Integer, startTable As Integer, num
As Integer, endTable As Integer
Dim cellText As String
endTable = 5
'机构的数量,根据各区县进行手动修改
'///////////////////////////////////////////第13行
Set
mytable = ActiveDocument.Tables(j)
mytable.cell(13, 2).Select
cellText = Left(mytable.cell(13, 2).Range, 2)
If
cellText = "内容" Then
'mytable.cell(13, 1).Select
Application.Run ("填灰色")
Selection.Paste
End If
'////////////////////////////////////////////////////////////////第24行
mytable.cell(24, 2).Select
cellText = Left(mytable.cell(24, 2).Range,
2)
If cellText = "内容"
Then
' mytable.cell(24, 1).Select
Application.Run ("填灰色")
'Selection.Paste
End If
'///////////////////////////////////////第41行
mytable.cell(41, 2).Select
cellText = Left(mytable.cell(41, 2).Range,
2)
If cellText = "评定" Then
Application.Run ("填灰色")
End If
'///////////////////////////////////////////////////////////////
'对于项目来说，只有11行需要替换/
For j
= endTable To ActiveDocument.Tables.count
Set
mytable = ActiveDocument.Tables(j)
mytable.cell(11, 2).Select
cellText =
Left(mytable.cell(11, 2).Range, 2)
If
cellText = "内容" Then
Application.Run ("填灰色")
Selection.Paste
End If
Next
'///////////////////////////////////////////////////////////////////////初始化
Dim i
As Integer, j As Integer, count As Integer, cellWidth As Integer,
endTable As Integer
'Dim name As
String
Dim
mytable As Table
Dim
cellA1(24) As cell, cellA2(11) As cell, cellB(29) As cell,
cellC(50) As cell, cellD(7) As cell
count =
ActiveDocument.Tables.count
endTable = 1
'机构的数量,根据各区县进行手动修改
'
///////////////////////////////////////////////////////////////////////循环
For j = 1 To endTable
'对于机构来说
'///////////////////////////////////////////
Set
mytable = ActiveDocument.Tables(j)
mytable.cell(1, 1).Select
'
Selection.Paste
'//////////////////////////////// ' A1 ,24'
Set cellA1(0) =
mytable.cell(1, 1)
'总表数据
Set cellA1(1) =
mytable.cell(2, 1) '总表数据
Set cellA1(2) =
mytable.cell(3, 1) '总表数据
Set cellA1(3) =
mytable.cell(5, 1)
'总表数据
Set cellA1(4) =
mytable.cell(7, 1)
'总表数据，
Set cellA1(5) =
mytable.cell(8, 1)
'总表数据
Set cellA1(6) =
mytable.cell(9, 1)
'总表数据
Set cellA1(7) =
mytable.cell(10, 1)
'总表数据
Set cellA1(8) =
mytable.cell(11, 1)
'总表数据
Set cellA1(9) =
mytable.cell(12, 1)
'总表数据
Set
cellA1(10) = mytable.cell(2, 3)
'总表数据
Set
cellA1(11) = mytable.cell(3, 2)
'总表数据
Set cellA1(12) = mytable.cell(4, 2)
'总表数据
Set cellA1(13) = mytable.cell(5, 2)
'总表数据
Set cellA1(14) = mytable.cell(6, 2)
'总表数据
Set cellA1(15) =
mytable.cell(3, 4) '总表数据
Set
cellA1(16) = mytable.cell(4, 4)
'总表数据
Set
cellA1(17) = mytable.cell(5, 4)
'总表数据
Set cellA1(18) = mytable.cell(6, 4)
'总表数据
Set cellA1(19) = mytable.cell(13, 1)
'表1数据
Set cellA1(20) = mytable.cell(13, 2)
'表1数据
Set cellA1(21) = mytable.cell(24, 1)
'表1数据
Set cellA1(22) = mytable.cell(24, 2)
'表1数据
Set cellA1(23) = mytable.cell(49, 1)
'表3数据
'//////////////////////////////// ' A2
',11
Set
cellA2(0) = mytable.cell(14, 1)
'表1数据
Set
cellA2(1) = mytable.cell(14, 2)
'表1数据
Set
cellA2(2) = mytable.cell(17, 2)
'表1数据
Set
cellA2(3) = mytable.cell(19, 2)
'表1数据
Set
cellA2(4) = mytable.cell(22, 2)
'表1数据
Set
cellA2(5) = mytable.cell(25, 1)
'表2数据
Set
cellA2(6) = mytable.cell(25, 2) '表2数据
Set cellA2(7) = mytable.cell(33, 2)
'表2数据
Set cellA2(8) = mytable.cell(41, 1)
'表3数据
Set cellA2(9) = mytable.cell(42, 1)
'表3数据
Set cellA2(10) =
mytable.cell(48, 1)
'表3数据
'//////////////////////////////// 'B类 29
Set cellB(0) =
mytable.cell(1, 2) '总表数据
Set
cellB(1) = mytable.cell(2, 2) '总表数据
Set
cellB(2) = mytable.cell(2, 4)
'总表数据
Set
cellB(3) = mytable.cell(14, 3) '表1数据
Set
cellB(4) = mytable.cell(15, 3) '表1数据
Set
cellB(5) = mytable.cell(16, 3) '表1数据
Set
cellB(6) = mytable.cell(17, 3) '表1数据
Set
cellB(7) = mytable.cell(18, 3) '表1数据
Set
cellB(8) = mytable.cell(19, 3) '表1数据
Set
cellB(9) = mytable.cell(20, 3) '表1数据
Set
cellB(10) = mytable.cell(21, 3) '表1数据
Set
cellB(11) = mytable.cell(22, 3) '表1数据
Set
cellB(12) = mytable.cell(23, 3) '表1数据
Set
cellB(13) = mytable.cell(25, 3) '表2数据
Set
cellB(14) = mytable.cell(26, 3)
'表2数据
Set
cellB(15) = mytable.cell(27, 3)
'表2数据
Set
cellB(16) = mytable.cell(28, 3)
'表2数据
Set
cellB(17) = mytable.cell(29, 3)
'表2数据
Set
cellB(18) = mytable.cell(30, 3)
'表2数据
Set
cellB(19) = mytable.cell(31, 3)
'表2数据
Set cellB(20) =
mytable.cell(32, 3)
'表2数据
Set cellB(21) =
mytable.cell(33, 3)
'表2数据
Set
cellB(22) = mytable.cell(34, 3)
'表2数据
Set
cellB(23) = mytable.cell(35, 3)
'表2数据
Set
cellB(24) = mytable.cell(36, 3)
'表2数据
Set
cellB(25) = mytable.cell(37, 3)
'表2数据
Set
cellB(26) = mytable.cell(38, 3) '表2数据
Set
cellB(27) = mytable.cell(39, 3)
'表2数据
Set
cellB(28) = mytable.cell(40, 3)
'表2数据
'//////////////////////////////// 'C类 ,50
Set
cellC(0) = mytable.cell(3, 3) '总表数据
Set
cellC(1) = mytable.cell(4, 3) '总表数据
Set
cellC(2) = mytable.cell(5, 3)
'总表数据
Set
cellC(3) = mytable.cell(6, 3)
'总表数据
Set
cellC(4) = mytable.cell(3, 5)
'总表数据
Set
cellC(5) = mytable.cell(4, 5)
'总表数据
Set
cellC(6) = mytable.cell(5, 5)
'总表数据
Set
cellC(7) = mytable.cell(6, 5)
'总表数据
Set
cellC(8) = mytable.cell(9, 2)
'总表数据
Set
cellC(9) = mytable.cell(10, 2)
'总表数据
Set
cellC(10) = mytable.cell(11, 2)
'总表数据
Set
cellC(11) = mytable.cell(12, 2)
'总表数据
Set
cellC(12) = mytable.cell(14, 4)
'表1数据
Set cellC(13) = mytable.cell(15, 4)
'表1数据
Set cellC(14) = mytable.cell(16, 4)
'表1数据
Set cellC(15) = mytable.cell(17, 4)
'表1数据
Set cellC(16) = mytable.cell(18, 4)
'表1数据
Set cellC(17) = mytable.cell(19, 4)
'表1数据
Set
cellC(18) = mytable.cell(20, 4) '表1数据
Set
cellC(19) = mytable.cell(21, 4)
'表1数据
Set cellC(20) = mytable.cell(22, 4)
'表1数据
Set cellC(21) = mytable.cell(23, 4)
'表1数据
Set cellC(22) = mytable.cell(25, 4)
'表2数据
Set cellC(23) = mytable.cell(26, 4)
'表2数据
Set cellC(24) = mytable.cell(27, 4)
'表2数据
Set cellC(25) = mytable.cell(28, 4)
'表2数据
Set cellC(26) = mytable.cell(29, 4)
'表2数据
Set cellC(27) = mytable.cell(30, 4)
'表2数据
Set cellC(28) = mytable.cell(31, 4)
'表2数据
Set
cellC(29) = mytable.cell(32, 4)
'表2数据
Set cellC(30) = mytable.cell(33, 4)
'表2数据
Set cellC(31) = mytable.cell(34, 4)
'表2数据
Set cellC(32) = mytable.cell(35, 4)
'表2数据
Set cellC(33) = mytable.cell(36, 4)
'表2数据
Set cellC(34) = mytable.cell(37, 4)
'表2数据
Set cellC(35) = mytable.cell(38, 4)
'表2数据
Set cellC(36) = mytable.cell(39, 4)
'表2数据
Set cellC(37) = mytable.cell(40, 4)
'表2数据
Set
cellC(38) = mytable.cell(42, 2) '表3数据
Set
cellC(39) = mytable.cell(43, 2) '表3数据
Set
cellC(40) = mytable.cell(44, 2)
'表3数据
Set
cellC(41) = mytable.cell(45, 2)
'表3数据
Set
cellC(42) = mytable.cell(46, 2)
'表3数据
Set
cellC(43) = mytable.cell(47, 2)
'表3数据
Set
cellC(44) = mytable.cell(42, 3)
'表3数据
Set cellC(45) = mytable.cell(43, 3)
'表3数据
Set cellC(46) = mytable.cell(44, 3)
'表3数据
Set cellC(47) = mytable.cell(45, 3)
'表3数据
Set cellC(48) = mytable.cell(46, 3)
'表3数据
Set cellC(49) = mytable.cell(47, 3)
'表3数据
'//////////////////////////////// 'D类
2
'////////////////////////////////E 类
7
Set cellD(0) = mytable.cell(8,
2) '总表数据
Set cellD(1) =
mytable.cell(48, 2) '表3数据
Set cellD(2) =
mytable.cell(13, 3) '表1数据
Set cellD(3) =
mytable.cell(24, 3) '表2数据
Set
cellD(4) = mytable.cell(41, 2) '表3数据
Set cellD(5) =
mytable.cell(41, 3) '表3数据
Set cellD(6) =
mytable.cell(49, 2) '表3数据
'////////////////////////////////
'1..对24个A1类进行格式设定，黑体，水平居中，行宽13%
For i = 0
To 23
cellA1(i).Select
Application.Run MacroName:="cellA1Set"
Next
i =
0
'////////////////////////////////
'2.对11个A2类进行格式设定，黑体，水平居中.行宽6.5%
For i = 0
To 10
cellA2(i).Select
Application.Run MacroName:="cellA2Set"
Next
i = 0
'////////////////////////////////
'3.对29个B类进行格式设定，非黑体，水平居中
For i = 0
To 28
cellB(i).Select
Application.Run MacroName:="cellBSet"
Next
i = 0
'////////////////////////////////
'4.对50个C类进行格式设定，非黑体，左对齐，首行不缩
For ci = 0
To 49
cellC(i).Select
Application.Run MacroName:="cellCSet"
Next
i = 0
'////////////////////////////////
'5.对7个DEC类进行格式设定，其中2个D类首行缩进，左对齐，5个E类黑体居中，无固定列宽
For i = 0
To 1 'D类
cellD(i).Select
Application.Run MacroName:="cellDSet"
Next
For i = 2 To 6 'E类
cellD(i).Select
Application.Run MacroName:="cellESet"
Next
i = 0
Next
'///////////////////////////////////////////////////////////////
'对于项目来说，只有11行需要替换/
For j
= endTable To ActiveDocument.Tables.count
' Set
mytable = ActiveDocument.Tables(j)
'
mytable.cell(1, 1).Select
Next
With
Selection.Font
.NameFarEast = "仿宋"
.NameAscii = ""
.NameOther = ""
.name = "仿宋"
.Size = 11
.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
.Spacing = 0
.Scaling = 100
.Position = 0
.Kerning = 1
.Animation = wdAnimationNone
.DisableCharacterSpaceGrid = False
.EmphasisMark = wdEmphasisMarkNone
End With
With
Selection.Font
.NameFarEast = "仿宋"
.NameAscii = ""
.NameOther = ""
.name = "仿宋"
.Size = 11
.Bold = False
'字体不是黑色
.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
.Spacing = 0
.Scaling = 100
.Position = 0
.Kerning = 1
.Animation = wdAnimationNone
.DisableCharacterSpaceGrid = False
.EmphasisMark = wdEmphasisMarkNone
End With
Selection.Cells(1).SetWidth ColumnWidth:=60,
RulerStyle:=wdAdjustProportional
Application.Run "设置黑体"
'字体设置黑体
Application.Run
"清除首行缩进"
Selection.SelectCell
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
'在表格中上左右下居中
Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
Selection.Cells(1).SetWidth ColumnWidth:=30,
RulerStyle:=wdAdjustProportional
Application.Run "设置黑体"
'字体设置黑体
Application.Run
"清除首行缩进"
Selection.SelectCell
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
'在表格中上左右下居中
Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
Application.Run "设置非黑体"
'字体非黑体
Application.Run "清除首行缩进"
Selection.SelectCell
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
'在表格中上左右下居中
Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
Application.Run
"设置非黑体"
Application.Run "清除首行缩进"
Selection.SelectCell
Selection.ParagraphFormat.Alignment =
wdAlignParagraphJustify
'在表格中上下居中，左对齐
Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
Selection.SelectCell
Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
With Selection.Font
'设置字体为非黑体
.NameFarEast = "仿宋"
.NameAscii = "仿宋"
.NameOther = "仿宋"
.name = "仿宋"
.Size = 11
.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
.Spacing = 0
.Scaling = 100
.Position = 0
.Kerning = 0
.Animation = wdAnimationNone
.DisableCharacterSpaceGrid = False
.EmphasisMark = wdEmphasisMarkNone
End With
With
Selection.ParagraphFormat '设置段落格式为缩进
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceMultiple
.LineSpacing = LinesToPoints(1.3)
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.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
.AutoAdjustRightIndent = True
.DisableLineHeightGrid = False
.FarEastLineBreakControl = True
.WordWrap = True
.HangingPunctuation = True
.HalfWidthPunctuationOnTopOfLine = False
.AddSpaceBetweenFarEastAndAlpha = True
.AddSpaceBetweenFarEastAndDigit = True
.BaseLineAlignment = wdBaselineAlignAuto
End With
With
Selection.ParagraphFormat
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.FirstLineIndent = CentimetersToPoints(0)
End With
'///////////////////////////////////////////////////////////////////////初始化
Dim i
As Integer, j As Integer, count As Integer, cellWidth As Integer,
endTable As Integer
'Dim name As
String
Dim
mytable As Table
Dim
cellA1(19) As cell, cellA2(5) As cell, cellB(3) As cell, cellC(13)
As cell, cellD(1) As cell
count =
ActiveDocument.Tables.count
endTable = 1
'机构的数量,根据各区县进行手动修改
'
///////////////////////////////////////////////////////////////////////循环
For j = 1 To endTable
'对于机构来说
'///////////////////////////////////////////
Set
mytable = ActiveDocument.Tables(j)
'mytable.cell(1, 1).Select
mytable.cell(1, 1).Range.Text = "项目名称"
mytable.cell(1, 2).Range.Text =
"2012-2014年度上海市职业技能培训项目办学质量和诚信等级评定"
mytable.cell(2, 3).Range.Text = "委托单位"
mytable.cell(2, 4).Range.Text = "上海市就业促进中心"
'mytable.cell(2, 4).SetWidth ColumnWidth:=120,
RulerStyle:=wdAdjustProportional
'mytable.cell(3,
5).SetWidth ColumnWidth:=90, RulerStyle:=wdAdjustProportional
mytable.cell(1, 1).Select
'//////////////////////////////// ' A
Set cellA1(0) =
mytable.cell(1, 1)
'总表数据
Set cellA1(1) =
mytable.cell(2, 1) '总表数据
Set cellA1(2) =
mytable.cell(3, 1) '总表数据
Set cellA1(3) =
mytable.cell(5, 1)
'总表数据
Set cellA1(4) =
mytable.cell(7, 1)
'总表数据，
Set cellA1(5) =
mytable.cell(8, 1)
'总表数据
Set cellA1(6) =
mytable.cell(9, 1)
'总表数据
Set cellA1(7) =
mytable.cell(10, 1)
'总表数据
Set cellA1(8) =
mytable.cell(11, 1)
'总表数据
Set cellA1(9) =
mytable.cell(12, 1)
'总表数据
Set
cellA1(10) = mytable.cell(2, 3)
'总表数据
Set
cellA1(11) = mytable.cell(3, 2)
'总表数据
Set cellA1(12) = mytable.cell(4, 2)
'总表数据
Set cellA1(13) = mytable.cell(5, 2)
'总表数据
Set cellA1(14) = mytable.cell(6, 2)
'总表数据
Set cellA1(15) =
mytable.cell(3, 4) '总表数据
Set
cellA1(16) = mytable.cell(4, 4)
'总表数据
Set
cellA1(17) = mytable.cell(5, 4)
'总表数据
Set cellA1(18) = mytable.cell(6, 4)
'总表数据
'//////////////////////////////// 'B类
Set cellB(0) =
mytable.cell(1, 2) '总表数据
Set
cellB(1) = mytable.cell(2, 2) '总表数据
Set
cellB(2) = mytable.cell(2, 4)
'总表数据
'//////////////////////////////// 'C类
Set
cellC(0) = mytable.cell(3, 3) '总表数据
Set
cellC(1) = mytable.cell(4, 3) '总表数据
Set
cellC(2) = mytable.cell(5, 3)
'总表数据
Set
cellC(3) = mytable.cell(6, 3)
'总表数据
Set
cellC(4) = mytable.cell(3, 5)
'总表数据
Set
cellC(5) = mytable.cell(4, 5)
'总表数据
Set
cellC(6) = mytable.cell(5, 5)
'总表数据
Set
cellC(7) = mytable.cell(6, 5)
'总表数据
Set
cellC(8) = mytable.cell(7, 2)
'总表数据
Set
cellC(9) = mytable.cell(9, 2)
'总表数据
Set
cellC(10) = mytable.cell(10, 2)
'总表数据
Set
cellC(11) = mytable.cell(11, 2)
'总表数据
Set
cellC(12) = mytable.cell(12, 2)
'总表数据
'//////////////////////////////// 'D类
Set cellD(0) = mytable.cell(8,
2) '总表数据
'//////////////////////////////// '1..对A类进行格式设定
For i = 0
To UBound(cellA1) - 1
cellA1(i).Select
Application.Run MacroName:="cellA1Set"
Next
i =
0
'////////////////////////////////
'3.对B类进行格式设定
For i = 0
To UBound(cellB()) - 1
cellB(i).Select
Application.Run MacroName:="cellBSet"
Next
i = 0
'////////////////////////////////
'4.对C类进行格式设
For i = 0
To UBound(cellC()) - 1
cellC(i).Select
Application.Run MacroName:="cellCSet"
Next
i = 0
'////////////////////////////////
'5.DE类进行格式设定
cellD(i).Select
Application.Run MacroName:="cellDSet"
i =
0
Next
'///////////////////////////////////////////////////////////////
'对于项目来说，只有11行需要替换/
For j
= endTable To ActiveDocument.Tables.count
' Set
mytable = ActiveDocument.Tables(j)
'
mytable.cell(1, 1).Select
Next
对所有表格进行统一初始化，比如表格自动按窗口大小调整，清除空白，选中文档中所有表格，自动添加行列等，大多数功能可以通过录制宏来实现。有些处理表格单元格的内容只能用VBA实现了。因为是新手，漏洞很多，仅供参考。
Sub select_alltables() '针对选中的每个表格进行设置
'选中全部表格，根据窗口调整表格
End Sub
Sub myset() '表格基础设置
'
' myset 全局设置'
'
'
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
End Sub
Sub 表格删行()
'
' 删除表格的行
''
End Sub
Sub 上下居中()
'
' 单元格上下居中，设置边距'
'
End Sub
Sub 表格删列() '全局使用
'
' 表格删列 宏'
'
End Sub
Sub 首行缩进()
'
' 首行缩进 宏
'
'
End Sub
Sub 显示行列号() '全局使用
If Selection.Information(wdWithInTable) = True Then
End Sub
Sub 取消文字环绕()
'
' 宏1 宏
'
'
End Sub
Sub 取消底色()
'
' 取消黄色底色
'
'
End Sub
Sub 删除空白() '一次使用
'
' 删除空白 宏
'
'
End Sub
Sub 取消自动编号()
'
' 宏1 宏
'
'
End Sub
Sub test() '一次使用
Dim myRange As Range
'Set ps =
Selection.Bookmarks("\headinglevel").Range.Paragraphs
Set ps =
ActiveDocument.Bookmarks("\headinglevel").Range.Paragraphs
For Each p In ps
Set myRange = p.Range
var Title = myRange.Text
MsgBox "编号：" & myRange.ListFormat.ListString & vbCrLf
& "标题内容：" & myRange.Text
Next p
'Set myRange =
Selection.Bookmarks("\headinglevel").Range.Paragraphs(1).Range
'MsgBox "编号：" & myRange.ListFormat.ListString & vbCrLf
& "标题内容：" & myRange.TextEnd Sub
Print
End Sub
Sub 自动填灰色() '一次性使用
'
'
For j = 1 To endTable '对于机构来说
Next
End Sub
Sub 填灰色()
'
' 填色 宏
'
'
End Sub
Sub 插入行()
'
' 插入行 宏
'
'
End Sub
Sub 插入行并黏贴文字()
'
' 宏1 宏
'
'
End Sub
Sub 自动设置表格前两行() '一次性使用
'
'
For j = 1 To endTable '对于机构来说
Next
End Sub
Sub 设置表格() '自编程序
End Sub
Sub 设置黑体()
'
' 设置字体为黑体
'
'
End Sub
Sub 设置非黑体()
'
' 设置字体为非黑体，仿宋
'
'
End Sub
Sub cellA1Set()
'A 类设置
' '
' 设置黑体，居中
End Sub
Sub cellA2Set()
'A 类设置
' '
' 设置黑体，居中
End Sub
Sub cellBSet()
'
' B类居中，非黑体
'
End Sub
Sub cellCSet()
'
' C类左对齐，非黑体，无首行缩进
'
'
End Sub
Sub cellDSet()
'
' D类左对齐，非黑体，首行缩进
'
'
End Sub
Sub 清除首行缩进()
'
' 宏1 宏
'
'
End Sub
Sub 设置表格1() '自编程序
End Sub
喜欢
0
赠金笔
前一篇：幽默-和斯坦先生游记
后一篇：谈快乐教育在家庭教育中的重要性