当前位置:编程学习 > VB >>

vb类模块调用时“对象变量或with块变量未设置”

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 HaveError()
'***************************************************************
'ErrMsg代码:1-word没有安装 2 - 缺少参数 3 - 没权限写文件
' 4 - 文件不存在
'
'***************************************************************


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


'********************************************************************************
' 从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
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
'********************************************************************************
' 从Word.Range对象mysel中查找FindStr,并替换为RepStr
' 替换次数由time参数确定,为0时,替换所有
'********************************************************************************
Dim findtxt As Boolean


If Len(FindStr) = 0 Then
C_ErrMsg = 2
RaiseEvent HaveError
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
Next
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
'********************************************************************************
' 把图像数据PicData,存为PicFile指定的文件
'********************************************************************************
On Error Resume Next


If Len(FileName) = 0 Then
C_ErrMsg = 2
RaiseEvent HaveError
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()
mysel.EndKey Unit:=wdStory, Extend:=wdExtend
mysel.Delete Unit:=wdCharacter, Count:=1
End Sub


Public Sub moveend()
'光标移动到文档结尾
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)
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 HaveError
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 HaveError
Exit Sub
End If
End Sub


Public Sub ViewDoc()
mywdapp.Visible = True
End Sub


Public Sub AddNewPage()
mysel.InsertBreak Type:=wdPageBreak
End Sub


Public Sub WordCut()
'保存模板页面内容
mysel.WholeStory
mysel.Cut
mysel.HomeKey Unit:=wdStory
End Sub


Public Sub WordCopy()
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()
'插入模块内容
mysel.Paste
End Sub


Public Sub CloseDoc()
'********************************************************************************
' 关闭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 SavetoDoc()
On Error Resume Next


'并另存为文件FileName


If Len(C_newDoc) = 0 Then
C_ErrMsg = 2
RaiseEvent HaveError
Exit Sub
End If


mywdapp.ActiveDocument.SaveAs (C_newDoc)


If Err.Number <> 0 Then
C_ErrMsg = 3
RaiseEvent HaveError
Exit Sub
End If


End Sub




Public Property Get TemplateDoc() As String
TemplateDoc = C_TemplateDoc
End Property


Public Property Let TemplateDoc(ByVal vNewValue As String)
C_TemplateDoc = vNewValue
End Property


Public Property Get newdoc() As String
newdoc = C_newDoc
End Property


Public Property Let newdoc(ByVal vNewValue As String)
C_newDoc = vNewValue
End Property


Public Property Get PicFile() As String
PicFile = C_PicFile
End Property


Public Property Let PicFile(ByVal vNewValue As String)
C_PicFile = vNewValue
End Property


Public Property Get ErrMsg() As Integer
ErrMsg = C_ErrMsg
End Property
这是从网上复制的一段类模块代码,使用的时候总是提示 对象变量或with块变量未设置  ,求助啊!!! --------------------编程问答-------------------- 你是如何使用的?模块、类、窗体里 ? --------------------编程问答-------------------- Dim A As New SetWord
A.ReplaceChar "#sbmc#", Text1.Text --------------------编程问答--------------------
引用 1 楼  的回复:
你是如何使用的?模块、类、窗体里 ?
Dim A As New SetWord
A.ReplaceChar "#sbmc#", Text1.Text
补充:VB ,  VBA
CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,