b表单处理
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158Dim aarr(1 To 20), bbrr(1 To 30, 1 To 30) '多列调整Sub 单表_一键调整(control As IRibbonControl) '单表-格式 '功能：光标在表格中处理当前表格 ...
c数字
1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586Sub 千分位符(control As IRibbonControl) '数字-千分位符 On Error Resume Next Dim i As Range, Acell As Cell, CR As Range On Error Resume Next Application.ScreenUpdating = False If Selection.Type = 2 Then '文档选定 For Each i In Selection.Words If IsNumeric(i) Then If i Like "####*&quo ...
d文字
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126Sub 宋体宋体(control As IRibbonControl) '选中范围字体为宋体+宋体 With Selection.Font .NameFarEast = "宋体" .NameAscii = "宋体" .NameOther = "宋体" End WithEnd SubSub 宋体罗马(control As ...
e大纲
123456789101112131415161718192021222324252627282930Sub 大纲一级(control As IRibbonControl) '大纲调整-一级 With Selection .Paragraphs.OutlineLevel = wdOutlineLevel1 End WithEnd SubSub 大纲二级(control As IRibbonControl) '大纲调整-二级 With Selection .Paragraphs.OutlineLevel = wdOutlineLevel2 End WithEnd SubSub 大纲三级(control As IRibbonControl) '大纲调整-三级 With Selection .Paragraphs.OutlineLevel = wdOutlineLevel3 End WithEnd SubSub 大纲四级(control As IRibbonControl) ...
fExcel贴数
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657Sub 粘贴格式文本(control As IRibbonControl) Set xl = GetObject(, "excel.application") xlr = xl.Selection.Rows.Count xlc = xl.Selection.Columns.Count With Selection wdc = .Information(16) wdr = .Information(13) rangeselect wdr, wdc, xlr, xlc ReDim arr(1 To 1) For Each sht In .Cells i = i + 1 ReDim Preserve arr(1 ...
g批注
123456789101112131415161718192021222324252627Sub 添加批注(control As IRibbonControl) '批注-添加批注 '添加批注 Application.ScreenUpdating = False '关闭屏幕更新 Selection.Collapse Direction:=wdCollapseEnd ActiveDocument.Comments.Add _ Range:=Selection.Range, Text:="" Application.ScreenUpdating = True '恢复屏幕更新End SubSub 删除批注(control As IRibbonControl) '批注-删除批注 '删除批注 On Error GoTo err_msgbox Selection.Comments(1).Delete Exit Suberr_msgbox: ...
h行列校验
1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283Sub 选行校验(control As IRibbonControl) '行列校验-选行校验 i = 0 x = 0 n = 0 If Selection.Type = wdSelectionColumn Then For Each Acell In Selection.Cells '求所选列合计数 If Acell.ColumnIndex > n Then n = Acell.ColumnIndex End If Set CR1 = ActiveDocument.Range(Acell.Range.Sta ...
j页面设置
12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273Sub 附注页面(control As IRibbonControl) '页面-页面设置 With ActiveDocument.PageSetup .Orientation = wdOrientPortrait .TopMargin = CentimetersToPoints(2.54) .BottomMargin = CentimetersToPoints(2.54) .LeftMargin = CentimetersToPoints(3.17) .RightMargin = CentimetersToPoints(2.7) .HeaderDistance = CentimetersToPoints( ...
i多表处理
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134Sub 多表_一键调整(control As IRibbonControl) '批量调整表格格式 Application.ScreenUpdating = False '关闭屏幕刷新 Application.DisplayAlerts = False '关闭提示 On Error Resume Next '忽略错误 ' ...
k访谈提纲
1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556Sub 插入访谈(x) Path = ActiveDocument.AttachedTemplate.FullName Application.Templates(Path).BuildingBlockEntries(x).Insert Where:=Selection.Range, RichText:=True With ActiveDocument.PageSetup .Orientation = wdOrientPortrait .TopMargin = CentimetersToPoints(2.54) .BottomMargin = CentimetersToPoints(2.54) .LeftMargin = CentimetersToPoints(3.17) .Righ ...
