（表格）简易编号（三个宏）v1

413191246se

* 功能：请执行《简易编号热键》宏，提示热键已经设置，在表格中选定任意一个单元格，按 F3 键：原样复制/F4 键：自动编号（向下编号至当前表格末行，编号格式有两种：纯数字/类似ZD2015037这样的<前缀+数字>。）

1. Sub 简易编号热键()
   
2.     KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyF3), KeyCategory:=wdKeyCategoryMacro, Command:="原样复制"
   
3.     KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyF4), KeyCategory:=wdKeyCategoryMacro, Command:="自动编号"
   
4.     MsgBox "F3：原样复制  F4：自动编号", vbOKOnly + vbExclamation, "简易编号热键"
   
5. End Sub
   
6. Sub 原样复制()
   
7.     If Selection.Information(wdWithInTable) = False Then MsgBox "请将光标放在表格中！", vbOKOnly + vbCritical, "原样复制": End
   
8. 
   
9.     Dim m As Long, n As Long, h As Long, i As String, c As Cell
   
10.     m = Selection.Information(wdStartOfRangeRowNumber)
    
11.     n = Selection.Information(wdStartOfRangeColumnNumber)
    
12.     h = Selection.Tables(1).Rows.Count
    
13.     Selection.SelectCell: Selection.MoveEnd Unit:=wdCharacter, Count:=-1
    
14.     If Asc(Selection) = 13 Then End 'Empty
    
15.     i = Selection.Text
    
16.     ActiveDocument.Range(Start:=Selection.Tables(1).Cell(m + 1, n).Range.Start, End:=Selection.Tables(1).Cell(h, n).Range.End).Select
    
17.     For Each c In Selection.Cells
    
18.         c.Range.Text = i
    
19.     Next
    
20.     Selection.Tables(1).Cell(m, n).Select
    
21. End Sub
    
22. Sub 自动编号()
    
23.     If Selection.Information(wdWithInTable) = False Then MsgBox "请将光标放在表格中！", vbOKOnly + vbCritical, "自动编号": End
    
24.     Dim m As Long, n As Long, h As Long, i As String, j As String, k As Long, v As Long, c As Cell, s As String
    
25.     m = Selection.Information(wdStartOfRangeRowNumber)
    
26.     n = Selection.Information(wdStartOfRangeColumnNumber)
    
27.     h = Selection.Tables(1).Rows.Count
    
28.     Selection.SelectCell: Selection.MoveEnd Unit:=wdCharacter, Count:=-1
    
29.     If Asc(Selection) = 13 Then End 'Empty
    
30.     j = Selection.Text: k = Len(Selection)
    
31.     Selection.MoveStart Unit:=wdCharacter, Count:=k - 1
    
32.     If Selection Like "[!0-9０-９]" Then Selection.EndKey Unit:=wdLine: End
    
33.     Do
    
34.         If Len(Selection) = k Then Exit Do
    
35.         Selection.MoveStart Unit:=wdCharacter, Count:=-1
    
36.     Loop Until Selection.Characters.First Like "[!0-9０-９]"
    
37.     If Selection.Characters.First Like "[!0-9０-９]" Then Selection.MoveStart Unit:=wdCharacter, Count:=1
    
38.     Selection.Range.CharacterWidth = wdWidthHalfWidth
    
39.     If Len(Selection) = k Then i = j: s = "" Else i = Selection.Text: s = Left(j, Len(j) - Len(i))
    
40.     i = i + 1
    
41.     ActiveDocument.Range(Start:=Selection.Tables(1).Cell(m + 1, n).Range.Start, End:=Selection.Tables(1).Cell(h, n).Range.End).Select
    
42.     For Each c In Selection.Cells
    
43.         c.Range.Text = s & i: i = i + 1
    
44.     Next
    
45.     Selection.Tables(1).Cell(m, n).Select
    
46. End Sub

复制代码

shenghua8

高手总是寂寞的。

413191246se

过奖！不敢当！3Q！