用VB自动操作Word的问题

[Tenner]

我现在想用VB实现以下功能:

自动运行Word，建立一个新文档，在其中写入表格、文字、插入图片等内容，然后对其进行排版、字体字号设置，最后进行页面设置、设置纸张大小等，然后将其保存为一个DOC文件。
以上过程我想全部用VB自动实现，请问如何做到，最好能给出源码。
谢谢了，分数不够我可以再加。

[BitBlt]

何必呢？
word对象多好啊/

[yinweihong]

你搜一下以前的帖子，很多关于word与vba宏的话题

[yinweihong]

eg:
Option Explicit
Dim xlDoc As New Document
Dim Visi As Boolean

Private Sub Form_Load()
'引用Microsoft Word x object library
Visi = xlDoc.Application.Visible
xlDoc.Application.Visible = True
xlDoc.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:=5
Selection.TypeText Text:="124122"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="412421"


Selection.MoveRight Unit:=wdCharacter, Count:=11
'注意这个Count数字以及下面内容打印的位置
Selection.TypeText Text:="34663"
Selection.TypeParagraph
Selection.TypeText Text:="356"



Selection.MoveLeft Unit:=wdCharacter, Count:=9 '移动光标
Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend
Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Style = ActiveDocument.Styles("标题 1") '文档设置
Selection.Font.Name = "Mangal" '字体设置
Selection.Font.Size = 14
Selection.Font.Bold = wdToggle
Selection.Font.Italic = wdToggle
Selection.Font.UnderlineColor = wdColorAutomatic
Selection.Font.Underline = wdUnderlineSingle


Selection.InlineShapes.AddPicture FileName:="..\*.jpg"'插入图片

等等，我相信你也应该对VBA宏熟悉吧...

[lsftest]

一个近似的例子：
Option Explicit

' If the same variable name is used more than once in the template, this
' array saves the application performing the same work again to get that
' data. It simply lifts it from this array.
Private UsedVariables() As String


Private Sub Command1_Click()

FillTemplates

End Sub

Private Sub FillTemplates()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim i As Integer, j As Integer
Dim NewResult As String


On Error GoTo ErrHandler

ReDim UsedVariables(0)

Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Open(App.Path & "\template.doc")


' For each section (header and footer)
For i = 1 To WordDoc.Sections.Count

' Headers
Debug.Print "Fields in Header:" & WordDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Fields.Count
For j = 1 To WordDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Fields.Count

If WordDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Fields(j).Type = wdFieldDocVariable Then

' Get the text for the field from the user
NewResult = GetNewResult(WordDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Fields(j), WordDoc)
'Insert New Text into the field
If NewResult <> "" Then
WordDoc.Sections(i).Headers(wdHeaderFooterPrimary).Range.Fields(j).Result.Text = NewResult
End If

End If

Next

' Footers
Debug.Print "Fields in Footer:" & WordDoc.Sections(i).Footers(wdHeaderFooterPrimary).Range.Fields.Count
For j = 1 To WordDoc.Sections(i).Footers(wdHeaderFooterPrimary).Range.Fields.Count

If WordDoc.Sections(i).Footers(wdHeaderFooterPrimary).Range.Fields(j).Type = wdFieldDocVariable Then

' Get the text for the field from the user
NewResult = GetNewResult(WordDoc.Sections(i).Footers(wdHeaderFooterPrimary).Range.Fields(j), WordDoc)
'Insert New Text into the field
If NewResult <> "" Then
WordDoc.Sections(i).Footers(wdHeaderFooterPrimary).Range.Fields(j).Result.Text = NewResult
End If

End If


Next

Next

' In main body
Debug.Print "Fields in main body: " & WordDoc.Fields.Count
For i = 1 To WordDoc.Fields.Count

If WordDoc.Fields(i).Type = wdFieldDocVariable Then

' Get the text for the field from the user
NewResult = GetNewResult(WordDoc.Fields(i), WordDoc)
'Insert New Text into the field
If NewResult <> "" Then
WordDoc.Fields(i).Result.Text = NewResult
End If

End If

Next

' lock the document to stop changes
WordDoc.Protect wdAllowOnlyComments, , "jd837djh82"
WordDoc.SaveAs App.Path & "\despatchnote.doc"

WordDoc.Close

WordApp.Quit
Set WordDoc = Nothing
Set WordApp = Nothing

MsgBox "Finished!"

Exit Sub
ErrHandler:

MsgBox "Unhanled Error: " & Err.Description

End Sub

[lsftest]

'接上：
Private Function GetNewResult(wField As Word.Field, WordDoc As Word.Document) As String

Dim StopPos As Long
Dim Variable As String
Dim UsedVariable As String
Dim VariableValue As String
Dim wRange As Word.Range

Debug.Print wField.Code

' These three lines strip down the field code to find
' out it's name
StopPos = InStrRev(wField.Code, "\*")
Variable = Left(wField.Code, StopPos - 3)
Variable = Right(Variable, Len(Variable) - 14)

' Check this field hasn't already appeared in this
' document.
If CheckUsedVariable(Variable) Then

VariableValue = GetVariableValue(Variable)

Else

Select Case UCase(Variable)

' I don't simply want to insert a string -
' I wish to insert a table at the Product Field.
Case "PRODUCT"

' Get the range (location) of the product field
Set wRange = wField.Code
' Delete the field, as any text will be inserted into the
' {} of the existing field.
wField.Delete

' Enter our table information including headers.
' Ideally, I would get this data from an ADO recordset
' using GetString().
With wRange

.Text = "PRODUCT" & vbTab & "CTSBATCHNO" & vbTab & "SUPP REF" & vbTab & "PACKNO" & vbTab & "STORAGE" & vbTab & "QTY UNITS" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3" & vbCrLf & _
"989797897" & vbTab & "hjhkhk" & vbTab & "kjhkjhkh" & vbTab & "kjhkjh" & vbTab & "Frozen" & vbTab & "3"

.FormattedText.Font.Name = "Arial"
.FormattedText.Font.Size = "8"

' Once the data is there, we can convert it to a table
' structure and format it to look pretty!
.ConvertToTable vbTab, , , , wdTableFormatColorful2

End With

' Send back blank string as field does not exist anymore
VariableValue = ""

Case Else

' Get the value of the field from the user
VariableValue = InputBox("Enter value for: " & Variable, "Value not recognised for Despatch Note!")
AddNewVariable Variable, VariableValue

End Select

End If

GetNewResult = VariableValue

End Function

Private Function GetVariableValue(Variable As String) As String
Dim i As Integer

For i = 0 To UBound(UsedVariables)
If Left(UsedVariables(i), Len(Variable)) = Variable Then
GetVariableValue = Right(UsedVariables(i), Len(UsedVariables(i)) - Len(Variable))
Exit For
End If
Next

End Function

Private Sub AddNewVariable(Variable As String, TheValue As String)
Dim ArraySize As Integer

ArraySize = UBound(UsedVariables)
ReDim Preserve UsedVariables(ArraySize + 1)
UsedVariables(ArraySize) = Variable & TheValue

End Sub

Private Function CheckUsedVariable(Variable As String) As Boolean
Dim i As Integer

For i = 0 To UBound(UsedVariables)
If Left(UsedVariables(i), Len(Variable)) = Variable Then
CheckUsedVariable = True
Exit For
End If
Next

End Function

[Tenner]

请大家不要吵，我正在写一个工程，中间要用到生成word文件，以前没做过这类工程，所以来这里问一下。
过几天工程就要交工了，等我交了工就结贴，如果有更好的代码或注释，请放出来，谢谢了~

[vansoft]

看宏代码基本没用的。

[yoyofish]

不要听vansoft乱讲，这小子居心叵测
学vba最好的方法就是看宏代码和查看office的联机帮助了
在编辑宏代码的时候选中你不懂的某个代码段，按f1，详细的解释都出来了

[yoyofish]

问一下楼主，是不是星不够的话，贴子就不能给超过100分？？

[Tenner]

是的