|
VBA：pd:shourou 以下为源代码供参考： Private Sub CommandButton1_Click()
On Error Resume Next
Me.Hide
Sz = Me.ComboBox1.ListIndex + 5
Bor = Me.ComboBox2.ListIndex
Rl = Me.ComboBox3.ListIndex
Ud = Me.ComboBox4.ListIndex
If Me.ComboBox2.Value = "More" Then MsgBox "Word注意到:您选取的框线为More,更多框线设置请在完成本功能后在目标文件的格式/边框和底纹中进行!"
Call SetUnderline
End Sub ‘--------------------------------------------------------------------------------------------------------------
Private Sub UserForm_Activate()
On Error Resume Next
Me.ComboBox1.ListIndex = 7
Me.ComboBox2.ListIndex = 0
Me.ComboBox3.ListIndex = 0
Me.ComboBox4.ListIndex = 0
Me.CommandButton1.Default = True
End Sub ’-------------------------------------------------------------------------------------------------------------- Private Sub UserForm_Initialize()
Dim i As Byte
On Error Resume Next
With Me.ComboBox1
For i = 5 To 30
.AddItem i
Next
End With
With Me.ComboBox2
.AddItem "下框线"
.AddItem "全框线"
.AddItem "More"
End With
With Me.ComboBox3
.AddItem "从左至右"
.AddItem "从右向左"
End With
With Me.ComboBox4
.AddItem "从上至下"
.AddItem "从下向上"
End With
End Sub ‘------------------------------------------------------------------------------------------------------------
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
Cancel = True
End Sub
‘-------------------------------------------------------------------------------------------------------- Public Sz As Byte, Bor As Byte, Rl As Byte, Ud As Byte
Sub SetUnderline()
Dim i As Integer, FilName As String, FilPath As String, LisValue As String, LineOf As Integer, Orient As Byte
Dim NewDoc As Document, NewTable As Table, n As Integer, X As Long, Y As Long, MyText As String
On Error GoTo ErrorHandle
Application.ScreenUpdating = False
With ActiveDocument
.Content.Font.Size = Sz * 1.1
FilPath = .Path
FilName = .Name
Orient = .Content.Orientation
CommandBars("Word Count").Visible = True
CommandBars("Word Count").Controls(2).Execute
LisValue = CommandBars("Word Count").Controls(1).List(6)
CommandBars("Word Count").Visible = False
LineOf = Int(Mid(LisValue, 1, Len(LisValue) - 1))
End With
Set NewDoc = Documents.Add
With NewDoc
.SaveAs FileName:=FilPath & "\U" & FilName
Set NewTable = .Tables.Add(Range:=Selection.Range, NumRows:=IIf(Orient = 0, LineOf, 1), NumColumns:=IIf(Orient = 0, 1, LineOf))
End With
Documents(FilName).Activate
With ActiveDocument
.Range(0, 0).Select
For n = 1 To LineOf
Selection.EndKey unit:=wdLine
Selection.HomeKey unit:=wdLine, Extend:=wdExtend
MyText = IIf(Rl = 0, Selection, StrReverse(Selection))
NewTable.Cell(IIf(Orient = 0, IIf(Ud = 0, n, LineOf - n + 1), 1), IIf(Orient = 0, 1, IIf(Ud = 0, n, LineOf - n + 1))).Range.Text = MyText
Selection.MoveDown unit:=wdLine, Count:=1
Next
End With
With NewDoc
.Activate
.Tables(1).Select
.PageSetup.Orientation = IIf(Orient = 1, wdOrientLandscape, wdOrientPortrait)
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorRed
End With
Select Case Bor
Case 0
Application.Run "BorderBottom"
Application.Run "BorderHoriz"
Case 1
Application.Run "BorderAll"
End Select
.Content.Font.Size = Sz
End With
Documents(FilName).Content.Font.Size = Sz
Application.ScreenUpdating = True
Exit Sub
ErrorHandle:
MsgBox "Word遇到不可预测性错误，本程序将不能正确执行，请检查后再运行！"
Exit Sub
End Sub ’-------------------------------------------------------------------------------------------------------------
Sub ShowMe()
UserForm1.Show
End Sub
| 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2004-8-22 09:04
楼主
