1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158
| Dim aarr(1 To 20), bbrr(1 To 30, 1 To 30) Sub 单表_一键调整(control As IRibbonControl) Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next Dim mytable As Table, i As Long For Each mytable In Selection.Tables With mytable .Shading.ForegroundPatternColor = wdColorAutomatic .Shading.BackgroundPatternColor = wdColorAutomatic Options.DefaultHighlightColorIndex = wdNoHighlight .Range.HighlightColorIndex = wdNoHighlight .Style = "表格主题" With .Borders(wdBorderLeft) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth150pt End With With .Borders(wdBorderRight) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth150pt End With With .Borders(wdBorderTop) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth150pt End With With .Borders(wdBorderBottom) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth150pt End With With .Borders(wdBorderVertical) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth050pt End With With .Borders(wdBorderHorizontal) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth050pt End With .Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone .Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone .TopPadding = CentimetersToPoints(0) .BottomPadding = CentimetersToPoints(0) .LeftPadding = PixelsToPoints(0, True) .RightPadding = PixelsToPoints(0, True) .Spacing = PixelsToPoints(0, True) .AllowPageBreaks = True With .Rows .WrapAroundText = False .AllowBreakAcrossPages = False .Height = CentimetersToPoints(0.8) .HeightRule = wdRowHeightAtLeast .LeftIndent = CentimetersToPoints(0) End With With .Range With .Font .NameFarEast = "宋体" .NameAscii = "Times New Roman" .NameOther = "Times New Roman" .Color = wdColorAutomatic .Size = 10.5 .Kerning = 0 .DisableCharacterSpaceGrid = True End With With .ParagraphFormat .LineUnitBefore = 0 .LineUnitAfter = 0 .SpaceBefore = 0 .SpaceAfter = 0 .CharacterUnitFirstLineIndent = 0 .FirstLineIndent = CentimetersToPoints(0) .LineSpacingRule = wdLineSpaceSingle .AutoAdjustRightIndent = False .DisableLineHeightGrid = True End With .Cells.VerticalAlignment = wdCellAlignVerticalCenter End With For Each cl In .Range.Cells Acell = ActiveDocument.Range(cl.Range.Start, cl.Range.End - 1).Text If IsNumeric(Acell) Then cl.Range.ParagraphFormat.Alignment = wdAlignParagraphRight Else cl.Range.ParagraphFormat.Alignment = wdAlignParagraphJustify If Acell = "合计" Or Acell = "总计" Or Acell = "总 计" Or Acell = "合 计" Then cl.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter If cl.ColumnIndex = .Columns.Count Then .Columns(cl.ColumnIndex).Select Selection.Font.Bold = True Else cl.Row.Range.Font.Bold = True End If ElseIf Acell = "序号" Or Acell = "序 号" Then .Columns(cl.ColumnIndex).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter End If End If Next .Rows(1).Select With Selection .Rows.HeadingFormat = wdToggle .ParagraphFormat.Alignment = wdAlignParagraphCenter .Range.Font.Bold = True .Shading.ForegroundPatternColor = wdColorAutomatic .Shading.BackgroundPatternColor = -603923969 End With .Columns.PreferredWidthType = wdPreferredWidthAuto .AutoFitBehavior (wdAutoFitContent) .AutoFitBehavior (wdAutoFitWindow) End With Next ERR.Clear: On Error GoTo 0 Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Sub 格宽调整_释放(control As IRibbonControl) Set mytable = Selection.Tables(1) For i = 1 To mytable.Rows.Count For j = 1 To mytable.Rows(i).Cells.Count mytable.Rows(i).Cells(j).Width = bbrr(i, j) Next j Next i End Sub Sub 格宽调整_读取(control As IRibbonControl) Set mytable = Selection.Tables(1) mytable.AutoFitBehavior (wdAutoFitFixed) For i = 1 To mytable.Rows.Count For j = 1 To mytable.Rows(i).Cells.Count bbrr(i, j) = mytable.Rows(i).Cells(j).Width Next j Next i End Sub Sub 列宽调整_读取(control As IRibbonControl) With Selection.Tables(1) ColumnsCounts = .Columns.Count For i = 1 To ColumnsCounts aarr(i) = .Columns(i).Width Next End With End Sub Sub 列宽调整_释放(control As IRibbonControl) With Selection.Tables(1) .AutoFitBehavior (wdAutoFitFixed) ColumnsCounts = .Columns.Count For i = 1 To ColumnsCounts .Columns(i).Width = aarr(i) Next End With End Sub
|