Sub 全选所有表格()
Dim t As Table
an = MsgBox("即将选择选区内所有表格,若无选区,则选择全文表格。", vbYesNo, "reboot提醒您!")
If an - 6 Then Exit Sub
Set rg = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
For Each t In rg.Tables
t.Range.Editors.Add wdEditorEveryone
Next
ActiveDocument.SelectAllEditableRanges wdEditorEveryone
ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
End Sub
Sub 全选所有表格首行()
Dim t As Table
Dim firstRow As Row
an = MsgBox("即将选择选区内所有表格的首行,若无选区,则选择全文表格的首行。", vbYesNo, "reboot提醒您!")
If an - 6 Then Exit Sub
Set rg = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
For Each t In rg.Tables
If t.Rows.Count >= 1 Then
Set firstRow = t.Rows(1)
firstRow.Range.Editors.Add wdEditorEveryone
End If
Next
ActiveDocument.SelectAllEditableRanges wdEditorEveryone
ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
End Sub
Sub 全选所有表格_调整格式()
Dim t As Table
Dim an As Integer
Dim rg As Range
Dim tableCount As Integer
Dim cell As cell
' 确认提示
an = MsgBox("即将格式化选区内所有表格,若无选区,则格式化全文表格。" & vbCrLf & _
"操作包括:" & vbCrLf & _
"1. 根据窗口调整宽度" & vbCrLf & _
"2. 平均分布各行" & vbCrLf & _
"3. 设置行高为1厘米" & vbCrLf & _
"4. 设置单元格文本左对齐", vbYesNo, "reboot提醒您!")
If an <> vbYes Then Exit Sub
' 确定操作范围
Set rg = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
tableCount = 0
' 直接遍历表格并应用格式
Application.ScreenUpdating = False
For Each t In rg.Tables
' 应用表格级格式
t.AutoFitBehavior wdAutoFitWindow
t.Rows.DistributeHeight
t.Rows.Height = CentimetersToPoints(1)
t.Rows.HeightRule = wdRowHeightExactly
' 遍历单元格设置对齐方式
For Each cell In t.Range.Cells
cell.VerticalAlignment = wdCellAlignVerticalCenter ' 垂直居中
cell.Range.ParagraphFormat.Alignment = wdAlignParagraphLeft ' 水平左对齐
Next cell
tableCount = tableCount + 1
Next t
Application.ScreenUpdating = True
' 提示结果
If tableCount > 0 Then
MsgBox "已成功格式化 " & tableCount & " 个表格!", vbInformation
Else
MsgBox "未找到可格式化的表格!", vbExclamation
End If
End Sub