vb通过word模板输出文档 vba输出word

VB控制WORD,使用WORDR的模板.在指定位置输出数据,100分求

要把下列内容到写字板中，另存为SetWord.cls文件，然后在把它添加到工程中，就可以使用了。

VERSION 1.0 CLASS

BEGIN

MultiUse = -1 'True

Persistable = 0 'NotPersistable

DataBindingBehior = 0 'vbNone

DataSourceBehior = 0 'vbNone

MTSTransactionMode = 0 'NotAnMTSObject

END

Attribute VB_Name = "SetWord"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = True

Attribute VB_PredeclaredId = False

Attribute VB_Exed = False

Private mywdapp As Word.Application

Private mysel As Object

'属性值的模块变量

Private C_TemplateDoc As String

Private C_newDoc As String

Private C_PicFile As String

Private C_ErrMsg As Integer

Public Event HeError()

Attribute HeError.VB_Description = "出错时激发此.出错代码为ErrMsg属性"

'ErrMsg代码：1－word没有安装 2 - 缺少参数 3 - 没权限写文件

' 4 - 文件不存在

Public Function ReplacePic(FindStr As String, Optional Time As Integer = 0) As Integer

Attribute ReplacePic.VB_Description = "查找FindStr,并替换为PicFile所指向的文件,替换次数由time参数确定,为0时，替换所有"

' 从Word.Range对象mysel中查找所有FindStr，并替换为PicFile图像

' 替换次数由time参数确定，为0时，替换所有

If Len(C_PicFile) = 0 Then

C_ErrMsg = 2

Exit Function

End If

Dim i As Integer

Dim findtxt As Boolean

mysel.Find.ClearFormatting

mysel.Find.Replacement.ClearFormatting

With mysel.Find

.Text = FindStr

.Replacement.Text = ""

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchByte = True

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

mysel.HomeKey Unit:=wdStory

findtxt = mysel.Find.Execute(Replace:=True)

If Not findtxt Then

ReplacePic = 0

Exit Function

End If

i = 1

Do While findtxt

mysel.InlineShapes.AddPicture FileName:=C_PicFile

If i = Time Then Exit Do

i = i + 1

mysel.HomeKey Unit:=wdStory

findtxt = mysel.Find.Execute(Replace:=True)

Loop

ReplacePic = i

End Function

Public Function FindThis(FindStr As String) As Boolean

Attribute FindThis.VB_Description = "查找FindStr,如果模板中有FindStr则返回True"

If Len(FindStr) = 0 Then

C_ErrMsg = 2

Exit Function

End If

mysel.Find.ClearFormatting

mysel.Find.Replacement.ClearFormatting

With mysel.Find

.Text = FindStr

.Replacement.Text = ""

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchByte = True

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

mysel.HomeKey Unit:=wdStory

FindThis = mysel.Find.Execute

End Function

Public Function ReplaceChar(FindStr As String, RepStr As String, Optional Time As Integer = 0) As Integer

Attribute ReplaceChar.VB_Description = "查找FindStr,并替换为RepStr,替换次数由time参数确定,为0时，替换所有"

' 从Word.Range对象mysel中查找FindStr，并替换为RepStr

' 替换次数由time参数确定，为0时，替换所有

Dim findtxt As Boolean

If Len(FindStr) = 0 Then

C_ErrMsg = 2

RaiseEvent HeError

Exit Function

End If

mysel.Find.ClearFormatting

mysel.Find.Replacement.ClearFormatting

With mysel.Find

.Text = FindStr

.Replacement.Text = RepStr

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchByte = True

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

If Time > 0 Then

For i = 1 To Time

mysel.HomeKey Unit:=wdStory

findtxt = mysel.Find.Execute(Replace:=wdReplaceOne)

If Not findtxt Then Exit For

If i = 1 And Not findtxt Then

ReplaceChar = 0

Else

ReplaceChar = i

End If

Else

mysel.Find.Execute Replace:=wdReplaceAll

End If

End Function

Public Function GetPic(PicData() As Byte, FileName As String) As Boolean

Attribute GetPic.VB_Description = "把图像数据PicData,存为PicFile指定的文件"

' 把图像数据PicData,存为PicFile指定的文件

On Error Resume Next

If Len(FileName) = 0 Then

C_ErrMsg = 2

RaiseEvent HeError

Exit Function

End If

Open FileName For Binary As #1

If Err.Number <> 0 Then

C_ErrMsg = 3

Exit Function

End If

'二进制文件用Get,Put存放，读取数据

Put #1, , PicData

Close #1

C_PicFile = FileName

GetPic = True

End Function

Public Sub DeleteToEnd()

Attribute DeleteToEnd.VB_Description = "删除从当前位置到结尾的所有内容"

mysel.EndKey Unit:=wdStory, Extend:=wdExtend

mysel.Delete Unit:=wdCharacter, Count:=1

End Sub

Public Sub MoveEnd()

Attribute MoveEnd.VB_Description = "光标移动到文档结尾"

'光标移动到文档结尾

mysel.EndKey Unit:=wdStory

End Sub

Public Sub GotoLine(LineTime As Integer)

mysel.GoTo What:=wdGoToLine, Which:=wdGoToFirst, Count:=LineTime, Name:=""

End Sub

Public Sub OpenDoc(view As Boolean)

Attribute OpenDoc.VB_Description = "打开Word文件,View确定是否显示Word界面"

On Error Resume Next

' 打开Word文件，并给全局变量mysel赋值

If Len(C_TemplateDoc) = 0 Then

mywdapp.Documents.Add

Else

mywdapp.Documents.Open (C_TemplateDoc)

End If

If Err.Number <> 0 Then

C_ErrMsg = 4

RaiseEvent HeError

Exit Sub

End If

mywdapp.Visible = view

mywdapp.Activate

Set mysel = mywdapp.Application.Selection

'mysel.Select

End Sub

Public Sub OpenWord()

On Error Resume Next

' 打开Word程序，并给全局变量mywdapp赋值

Set mywdapp = CreateObject("word.application")

If Err.Number <> 0 Then

C_ErrMsg = 1

RaiseEvent HeError

Exit Sub

End If

End Sub

Public Sub ViewDoc()

Attribute ViewDoc.VB_Description = "显示Word程序界面"

mywdapp.Visible = True

End Sub

Public Sub AddNewPage()

Attribute AddNewPage.VB_Description = "插入分页符"

mysel.InsertBreak Type:=wdPageBreak

End Sub

Public Sub WordCut()

Attribute WordCut.VB_Description = "剪切模板所有内容到剪切板"

'保存模板页面内容

mysel.WholeStory

mysel.Cut

mysel.HomeKey Unit:=wdStory

End Sub

Public Sub WordCopy()

Attribute WordCopy.VB_Description = "拷贝模板所有内容到剪切板"

mysel.WholeStory

mysel.Copy

mysel.HomeKey Unit:=wdStory

End Sub

Public Sub WordDel()

mysel.WholeStory

mysel.Delete

mysel.HomeKey Unit:=wdStory

End Sub

Public Sub WordPaste()

Attribute WordPaste.VB_Description = "拷贝剪切板内容到当前位置"

'插入模块内容

mysel.Paste

End Sub

Public Sub CloseDoc()

Attribute CloseDoc.VB_Description = "关闭Word文件模板"

' 关闭Word文件模本

On Error Resume Next

mywdapp.ActiveDocument.Close False

If Err.Number <> 0 Then

C_ErrMsg = 3

Exit Sub

End If

End Sub

Public Sub QuitWord()

' 关闭Word程序

On Error Resume Next

mywdapp.Quit

If Err.Number <> 0 Then

C_ErrMsg = 3

Exit Sub

End If

End Sub

Public Sub SetoDoc()

Attribute SetoDoc.VB_Description = "保存当前文档为FileName指定文件"

On Error Resume Next

'并另存为文件FileName

If Len(C_newDoc) = 0 Then

C_ErrMsg = 2

RaiseEvent HeError

Exit Sub

End If

mywdapp.ActiveDocument.SeAs (C_newDoc)

If Err.Number <> 0 Then

C_ErrMsg = 3

RaiseEvent HeError

Exit Sub

End If

End Sub

Public Property Get TemplateDoc() As String

Attribute TemplateDoc.VB_Description = "模板文件名."

TemplateDoc = C_TemplateDoc

End Property

Public Property Let TemplateDoc(ByVal vNewValue As String)

C_TemplateDoc = vNewValue

End Property

Public Property Get newdoc() As String

Attribute newdoc.VB_Description = "执行CloseDoc方法时，将模板文件另存为此文件名指定的新文件.如果不指定，在执行CloseDoc方法时，将产生一个错误"

newdoc = C_newDoc

End Property

Public Property Let newdoc(ByVal vNewValue As String)

C_newDoc = vNewValue

End Property

Public Property Get PicFile() As String

Attribute PicFile.VB_Description = "图像文件名"

PicFile = C_PicFile

End Property

Public Property Let PicFile(ByVal vNewValue As String)

C_PicFile = vNewValue

End Property

Public Property Get ErrMsg() As Integer

Attribute ErrMsg.VB_Description = "错误信息.ErrMsg代码: 1-word没有安装 2-缺少参数 3-没权限写文件 4-文件不存在"

ErrMsg = C_ErrMsg

End Property

用vb从access调用数据，再利用word模版生成word文件?

两个对象，vb连接数据库应该会vb的都会把，直接拉个adodc控件，控制word是引用一个word对象，工程引用里面勾上，然后建立对象dim myWordapp as word.applcation set mywordapp=creatobject("word.applcation") myworapp.documents.add 然后就是随便用了，段是paragraph，还有range对象，selection，主要用这几个对象

vb怎么输出word文档

这个要使用部件，如果是数据，还是输出到Excel里。

在VB6中，添加引用“Microsoft Excel object Library”

过程中加入下列代码，就能读写EXCEL单元格了：

Set FileSys = CreateObject("scripting.fileobject")

Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类

xlApp.Visible = False '设置Excel不可见

Set xlBook = xlApp.Workbooks.Open(App.Path & "temp.xls") '打开Excel工作簿 temp.xls

Set xlsheet = xlBook.Worksheets(1) '打开Excel工作表(Sheet1)

xlsheet.Activate '激活工作表

xlsheet.Cells(1, 1) = "日期"

xlsheet.Cells(1, 2) = "时间"

程序结束时要用以下代码关闭EXCEL：

xlBook.RunAutoMacros (xlAutoClose) '执行EXCEL关闭宏

xlBook.Close (True) '关闭EXCEL工作簿

xlApp.Quit '关闭EXCEL

Set xlApp = Nothing '释放EXCEL对象

亲，您好！很高兴为您解答

一、开发思路

往返打字程序思路：

你可以直接按照保存txt文件那样，只是将后缀改为doc就行了，word可以直接阅读txt文本的

XML格式的Word或者txt都是文本文件。只需要按照格式填写好格式，需要输出的内容拼到一起即可。

怎样在VB中输出word文档

很麻烦，需要在vb中打开word应用程序——输入文档内容——保存文档——关闭word。

我用过建立交换文件的方法：vb中打开指定文件——输出内容——关闭文件，然后用word插入——文档功能读入。

如何把VB中TEXT数据输出到word模板中的指定位置

要把下列内容到写字板中，另存为SetWord.cls文件，然后在把它添加到工程中，就可以使用了。

VERSION 1.0 CLASS

BEGIN

MultiUse = -1 'True

Persistable = 0 'NotPersistable

DataBindingBehior = 0 'vbNone

DataSourceBehior = 0 'vbNone

MTSTransactionMode = 0 'NotAnMTSObject

END

Attribute VB_Name = "SetWord"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = True

Attribute VB_PredeclaredId = False

Attribute VB_Exed = False

Private mywdapp As Word.Application

Private mysel As Object

'属性值的模块变量

Private C_TemplateDoc As String

Private C_newDoc As String

Private C_PicFile As String

Private C_ErrMsg As Integer

Public Event HeError()

Attribute HeError.VB_Description = "出错时激发此.出错代码为ErrMsg属性"

'ErrMsg代码：1－word没有安装 2 - 缺少参数 3 - 没权限写文件

' 4 - 文件不存在

Public Function ReplacePic(FindStr As String, Optional Time As Integer = 0) As Integer

Attribute ReplacePic.VB_Description = "查找FindStr,并替换为PicFile所指向的文件,替换次数由time参数确定,为0时，替换所有"

' 从Word.Range对象mysel中查找所有FindStr，并替换为PicFile图像

' 替换次数由time参数确定，为0时，替换所有

If Len(C_PicFile) = 0 Then

C_ErrMsg = 2

Exit Function

End If

Dim i As Integer

Dim findtxt As Boolean

mysel.Find.ClearFormatting

mysel.Find.Replacement.ClearFormatting

With mysel.Find

.Text = FindStr

.Replacement.Text = ""

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchByte = True

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

mysel.HomeKey Unit:=wdStory

findtxt = mysel.Find.Execute(Replace:=True)

If Not findtxt Then

ReplacePic = 0

Exit Function

End If

i = 1

Do While findtxt

mysel.InlineShapes.AddPicture FileName:=C_PicFile

If i = Time Then Exit Do

i = i + 1

mysel.HomeKey Unit:=wdStory

findtxt = mysel.Find.Execute(Replace:=True)

Loop

ReplacePic = i

End Function

Public Function FindThis(FindStr As String) As Boolean

Attribute FindThis.VB_Description = "查找FindStr,如果模板中有FindStr则返回True"

急！用VB实现一个打印WORD文档功能。。。

先做好word模板文件，把需要用VB来作的地方留置特定格式的标识符号，用VB作word的替换功能来替换相应位置的文字

或者说在vb中把需要在word文件出现的文字全部拼接后再写入word

添加必要的按钮和文本框，ChMoney()函数没有粘贴，可以把相关的语句删除

Private Sub Command1_Click()

Dim ctrl As Control

For Each ctrl In Controls

If TypeOf ctrl Is TextBox Or TypeOf ctrl Is ComboBox Then

If ctrl.Text = "" Then Exit Sub

End If

On Error GoTo errHandler:

Dim objWord As Object

Set objWord = CreateObject("Word.Application")

objWord.Visible = True

objWord.Documents.Add

With objWord

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).Range.Font.Size = 36

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).SpaceAfter = 7.8

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).Range.Font.Bold = True

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).Range.Font.Name = "宋体"

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).Alignment = 1 '居中对齐

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).Range.Text = "证明"

.ActiveDocument.Paragraphs.Add

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).LineSpacingRule = 4

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).lineSpacing = 55

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).SpaceBefore = 0

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).SpaceAfter = 0

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).Range.Font.Size = 22

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).Range.Font.Bold = False

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).Range.Font.Name = "宋体"

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).Alignment = 0 '居中对齐

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).Range.Text = "县国税局："

.ActiveDocument.Paragraphs.Add

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).CharacterUnitFirstLineIndent = 2

TotalPr = Format(Val(txtPr) Val(txtWeight), "00.00") '总价

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).Range.Text = _

"今有" + CStr(txtCustom) + "销给我公司" + CStr(txtGoods) + _

CStr(txtWeight) + "吨，单价" + CStr(txtPr) + "元/吨，计款" + _

CStr(ChMoney(TotalPr)) + "整，小写￥" + TotalPr + _

"。请予办理纳税手续为盼。"

.ActiveDocument.Paragraphs.Add

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).CharacterUnitFirstLineIndent = 2.5

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).Range.Text = "特此证明！"

.ActiveDocument.Paragraphs.Add

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).Range.Font.Size = 18

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).LineSpacingRule = 4

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).lineSpacing = 40

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).CharacterUnitFirstLineIndent = 8.5

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).Range.Text = "固安县永丰新型建材有限公司"

.ActiveDocument.Paragraphs.Add

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).CharacterUnitFirstLineIndent = 10.5

.ActiveDocument.Paragraphs(.ActiveDocument.Paragraphs.Count).Range.Text = CStr(Year(Date)) + "年" + _

CStr(Month(Date)) + "月" + _

CStr(Day(Date)) + "日"

With .ActiveDocument.PageSetup

.TopMargin = 120 '1磅=0.035厘米

.BottomMargin = 90

.LeftMargin = 85

.RightMargin = 85

End With

'县国税局：TypeParagraph

.ActiveDocument.sed = True

End With

If MsgBox("确定打印?", vbYesNo) = vbYes Then

objWord.ActiveDocument.printout

objWord.quit

End If

Set objWord = Nothing

errHandler: '错误处理

MsgBox Err.Description + vbCrLf + "错误号:" + CStr(Err.Number), vbCritical, "出错"

Set objWord = Nothing

Exit Sub

End Sub

使用 Visual Basic for Application 功能，引用Word，对Word进行二次开发。

关于Word二次开发的的资料，在网上很多。

好像是通过Word内置的功能来打印，用不上你的commondialog控件

这里注册一个用户去下载看看：

最后修改时间： 2024-12-01 15:04