VBA for Word 学习笔记（一）

Sub test()


Dim name As String


name = InputBox("What is your name?")
MsgBox Prompt:="You name is :" & name


End Sub
Sub FindText()


Dim target As String
Dim num As Integer


target = InputBox("请输入要查找的内容")


With ActiveDocument.Content.Find
Do While .Execute(FindText:=target) = True
num = mun + 1
Loop
End With


MsgBox ("当前文档查找到" + str(num) + " 个 " + target)




End Sub
Sub TextSel()


Set myrange = ActiveDocument.Range( _
    Start:=ActiveDocument.Paragraphs(1).Range.Start, _
    End:=ActiveDocument.Paragraphs(2).Range.End)
    
myrange.Select


End Sub
Sub FontSet()


Set myrange = ActiveDocument.Paragraphs(1).Range
With myrange.Font
.Bold = True
.name = "黑体"
.Size = 24
End With


End Sub
Sub PageSet()


With ActiveDocument.PageSetup
.LeftMargin = InchesToPoints(0.75)
.RightMargin = InchesToPoints(0.75)
.TopMargin = InchesToPoints(1.5)
.BottomMargin = InchesToPoints(1.5)
End With


End Sub
Sub InsertWord()


Dim doc As Document
Dim i As Integer
i = InputBox("请输入插入文字的地方")
Set doc = ActiveDocument
Set myrange = doc.Range(Start:=doc.Paragraphs(i).Range.Start, End:=doc.Paragraphs(i).Range.End - 1)
myrange.InsertAfter "The End"


End Sub
Sub CheckWord()


Dim str As String
Dim i As Integer
str = Selection.Range.Text
If str Like "[A-Z]#[A-Z]#[A-Z]#" Then
MsgBox "OK"
Else
i = MsgBox("你输入的不是合法的加拿大邮编,删除？", vbYesNo)
If i = vbYes Then
Selection.Delete
End If
End If


End Sub
Sub ConvertWord()


Dim str, StrOut As String
Dim i As Integer
str = Selection.Range.Text
StrOut = StrConv(str, vbProperCase)
Selection.Text = StrOut


End Sub
Sub FormatWord()


'将一个字符串按照一定格式输出
'如果输入12345678901，则变为(123)4567-8901
Dim str, StrOut As String
str = Selection.Range.Text
StrOut = Format(str, "(&&&)&&&&-&&&&")
Selection.Text = StrOut


End Sub
Sub TableCount()


Dim i As Integer
i = ActiveDocument.Tables.Count
MsgBox "本文含有" & i & "个表格"


End Sub
Sub TableAdd()


Dim myrange As Range
Dim mytab As Table
Dim i As Integer
Set myrange = ActiveDocument.Range
Set mytab = ActiveDocument.Tables.Add(Selection.Range, 3, 4)


End Sub


Sub TableAddRecord()
'这个是通过录制宏得到的创建表格的宏
    ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=3, NumColumns:= _
        4, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
    With Selection.Tables(1)
        If .Style <> "网格型" Then
            .Style = "网格型"
        End If
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .ApplyStyleRowBands = True
        .ApplyStyleColumnBands = False
    End With
End Sub
Sub TableSeperate()


'Dim mytable As Table


ActiveDocument.Tables(4).Split (2)






End Sub
Sub TableAddText()
'添加一个表格，并填充一些数据


Set newDoc = Documents.Add


Set mytable = newDoc.Tables.Add(Selection.Range, 3, 3)
With mytable
If .Style <> "网格型" Then
.Style = "网格型"
End If
.Cell(1, 1).Range.InsertAfter "First Cell"
.Cell(mytable.Rows.Count, mytable.Columns.Count).Range.InsertAfter "Last Cell"
End With


End Sub
Sub TableAddText2()


Set doc = ActiveDocument
Set mytable = doc.Tables.Add(Range:=doc.Range(Start:=0, End:=0), NumRows:=3, NumColumns:=4)
Count = 1
For Each mycell In mytable.Range.Cells
mycell.Range.InsertAfter "cell" & Count
Count = Count + 1
Next mycell
mytable.AutoFormat Format:=wdTableFormatColorful2, ApplyBorders:=True, ApplyFont:=True, ApplyColor:=True


'这是删除文字的语法
mytable.Cell(1, 1).Range.Delete


End Sub
Sub New_Excel()
'
' New_Excel 宏
'
'


Dim ExcelSheet As Object
Set ExcelSheet = CreateObject("excel.sheet")
ExcelSheet.Application.Visible = True
ExcelSheet.Application.Cells(1, 1).Value = "This is column A ,row 1"
ExcelSheet.SaveAs "D:\TEST.XLS"
ExcelSheet.Application.Quit
Set ExcelSheet = Nothing


End Sub
Sub AllStyle()


Dim str As String
Dim sty As Style
For Each sty In ActiveDocument.Styles
    str = str & sty.Font.name & Chr(13)
Next sty
MsgBox str


End Sub
Sub ApplyStyle()


'Selection.Style = "提示"
'上面的代码无法执行


End Sub
Sub FileOperate()


Dim InFileName As String
Dim OutFileName As String
Dim InFileNum As Integer
Dim OutFileNum As Integer


Dim str As String
Dim result As String


InFileName = "D:\in.txt"
OutFileName = "D:\out.txt"


InFileNum = FreeFile()
OutFileNum = FreeFile() + 1


Open InFileName For Input As #InFileNum
Open OutFileName For Output As #OutFileNum


Do Until EOF(InFileNum)
Line Input #InFileNum, str
result = result & str & Chr(13)
Loop




Print #OutFileNum, result


Close #InFileNum
Close #OutFileNum


MsgBox ("success")


End Sub