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