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
| Sub 粘贴格式文本(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 To i)
arr(i) = sht.Range.Font.Underline
Next
.CopyFormat
.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
.PasteFormat
With .Find
.Text = " "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With
rangeselect wdr, wdc, xlr, xlc
For Each sht In .Cells
j = j + 1
sht.Range.Font.Underline = arr(j)
Next
End With
End Sub
Sub 双下划线(control As IRibbonControl)
If Selection.Font.Underline = wdUnderlineDouble Then
Selection.Font.Underline = wdUnderlineNone
ElseIf Selection.Font.Underline = wdUnderlineNone Then
Selection.Font.Underline = wdUnderlineDouble
End If
End Sub
Sub 单下划线(control As IRibbonControl)
If Selection.Font.Underline = wdUnderlineSingle Then
Selection.Font.Underline = wdUnderlineNone
ElseIf Selection.Font.Underline = wdUnderlineNone Then
Selection.Font.Underline = wdUnderlineSingle
End If
End Sub
Function rangeselect(wdr, wdc, xlr, xlc)
With Selection
.Tables(1).Cell(wdr, wdc).Select
.Collapse wdCollapseStart
st = .Start
.Tables(1).Cell(wdr + xlr - 1, wdc + xlc - 1).Select
.Collapse wdCollapseEnd
ed = .End
ActiveDocument.Range(st, ed).Select
End With
End Function
|