Word 2007巨集 - 自動產生表格

http://alexsir.blogspot.com/2009/03/word2007.html
2009年3月19日 星期四
WORD2007巨集 - 自動產生表格
Sub 表格()'' 表格 巨集'
Dim x, ix = InputBox("請輸入表格列數")

...繼續閱讀

2009年3月19日 星期四
WORD2007巨集 - 自動產生表格
Sub 表格()'' 表格 巨集'
Dim x, ix = InputBox("請輸入表格列數")

ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=x + 1, NumColumns:= _ 8, 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 Selection.TypeText Text:="no" Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.TypeText Text:="name" Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.TypeText Text:="tel" Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.TypeText Text:="memo" Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.TypeText Text:="date" Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.TypeText Text:="address" Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.TypeText Text:="email" Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.TypeText Text:="web" Selection.MoveRight Unit:=wdCharacter, Count:=2 For i = 1 To x Step 1 Selection.TypeText Text:=i Selection.MoveDown Unit:=wdLine, Count:=1 Next i End Sub





範例{改成100欄跟數字.docm }:

Sub 表格()
'
' 表格 巨集
'
'
Dim x, i

x = InputBox("entry your rows")

ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=x + 1, NumColumns:= _
8, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitWindow
With Selection.Tables(1)
If .Style <> "表格格線" Then
.Style = "表格格線"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
Selection.TypeText Text:="a"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="b"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="b"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="b"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="b"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="b"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="c"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="dttt"
Selection.MoveRight Unit:=wdCell

For i = 1 To x Step 1


Selection.TypeText Text:=i
Selection.MoveDown Unit:=wdLine, Count:=1

Next i

End Sub