我一直在excel中创建一个宏,该宏将从excel工作表中提取信息并插入word文档中。
经过多次尝试和错误,我已经设法让它插入了我想要的所有信息,但我现在只能更改插入内容的格式。
在尝试了许多不同的方法来更改宏中的格式后(都不起作用(,我决定在word VBA中创建一些函数来进行我想要的格式更改(即更改为样式、粗体或格式为项目符号(。这些函数在word中工作时没有任何问题。但是每当我从excel宏调用它们时,我都会得到一个运行时错误"438"对象不支持此属性或方法。我反复检查了对象库这个词,在这个阶段,我假设我正在做excel对象不喜欢的事情,但就我的一生而言,我不知道问题出在哪里。
这是excel宏的一小部分,如果我在不调用单词function的情况下运行它,它会很好地工作。我试着用wrdApp把电话放在里面,但没有成功。我也试着用wrdDoc把它拉到外面,但也没用。
Sub ExportData()
'
' ExportData Macro
' Export the data from excel into a more usable form in word
'
Dim sheetcounter As Integer
Dim counter As Integer
Dim numbsheets As Integer
Dim numbepisodes As Integer
Dim wrdApp As Object, wrdDoc As Object
Dim episodetitle As String
Dim nextepisodetitle As String
Dim season As Variant
Dim series As String
Dim episodenumber As String
Dim releasedate As Variant
Dim length As String
Dim fndDay As Integer
Dim fndMnth As Integer
Dim hrs As String
Dim mns As String
Dim scs As String
Dim lnglgth As String
Dim sheetname As String
Dim myRange As Range
Dim lookupRange As Range
Dim datarng As Range
Dim text As Range
Set wrdApp = CreateWord
Set wrdDoc = wrdApp.Documents.Add
With wrdDoc
numbsheets = Application.Sheets.Count
.Content.ParagraphFormat.SpaceBefore = 0
.Content.ParagraphFormat.SpaceAfter = 0
.Content.InsertAfter "Internal Wiki"
Call wrdApp.cntrl("Internal Wiki", "Style", "Title")
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
这是cntrl单词函数
Public Function cntrl(txt As String, fnctn As String, optn As String, Optional optnsize As Integer) as Object
'
' A function to control the word functions from excel
'
'
Dim myRange As Range
Set myRange = fndtxt(txt)
If fnctn = "Style" Then
Call Style(myRange, optn)
ElseIf fnctn = "List" Then
Call List(myRange, optn)
ElseIf fnctn = "Format" Then
If IsMissing(optnsize) Then
Call format(myRange, optn)
Else
Call format(myRange, optn, optnsize)
End If
End If
End Function
fnd-txt函数
Public Function fndtxt(txt As String) As Range
'
' A function to find text and return it as a range. To be used in combination with the formatting funcitons
'
'
Set fndtxt = ActiveDocument.Range
With fndtxt.Find
.text = txt
.Forward = True
.Execute
End With
End Function
以及风格功能。
Public Function Style(txt As Range, stylename As String) As Object
'
' A function to apply styles to ranges
'
'
Dim myRange As Range
Set myRange = txt
myRange.Style = stylename
End Function
我把它们分成单独的功能,这样如果我想的话,我可以单独使用它们,或者在控制功能中一起使用。我确信这不是最有效的方法,但在连续工作了3天后,我需要把东西分开,否则我会患上动脉瘤。为了通过,我尝试将它们作为sub而不是函数,但得到了相同的错误。
我在所有的格式化函数中都遇到了同样的错误,我只关注样式一,因为这似乎是简化事情并使其更容易解释的最佳方式:(。如果需要的话,很乐意发布这些。
很抱歉,如果这个问题得到了回答,我浏览了论坛,但没有看到这样的内容。
非常感谢所有的帮助,这让我发疯了。
编辑:
非常感谢蒂姆,这现在正在工作,这是更改后的工作代码。我把函数移到excel中,你可以在下面找到它们。
Excel宏
Sub ExportData()
'
' ExportData Macro
' Export the data from excel into a more usable form in word
'
Dim sheetcounter As Integer
Dim counter As Integer
Dim numbsheets As Integer
Dim numbepisodes As Integer
Dim wrdApp As Object, wrdDoc As Object
Dim episodetitle As String
Dim nextepisodetitle As String
Dim season As Variant
Dim series As String
Dim episodenumber As String
Dim releasedate As Variant
Dim length As String
Dim fndDay As Integer
Dim fndMnth As Integer
Dim hrs As String
Dim mns As String
Dim scs As String
Dim lnglgth As String
Dim sheetname As String
Dim myRange As Range
Dim lookupRange As Range
Dim datarng As Range
Dim text As Range
Set wrdApp = Createword
Set wrdDoc = wrdApp.Documents.Add
With wrdDoc
numbsheets = Application.Sheets.Count
.Content.ParagraphFormat.SpaceBefore = 0
.Content.ParagraphFormat.SpaceAfter = 0
.Content.InsertAfter "DnD is for Nerds Wiki"
Call cntrl(wrdDoc, "DnD is for Nerds Wiki", "Style", "Title")
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
cntrl函数
Public Function cntrl(doc As Word.Document, txt As String, fnctn As String, optn As String, Optional optnsize As Integer) As Object
'
' A function to control the word funcitons from excel
'
'
Dim myRange As Word.Range
Set myRange = fndtxt(doc, txt)
If fnctn = "Style" Then
Call Style(myRange, optn)
ElseIf fnctn = "List" Then
Call List(myRange, optn)
ElseIf fnctn = "Format" Then
If IsMissing(optnsize) Then
Call format(myRange, optn)
Else
Call format(myRange, optn, optnsize)
End If
End If
End Function
fndtxt函数
Public Function fndtxt(doc As Word.Document, txt As String) As Word.Range
'
' A function to find text and return it as a range. To be used in combination with the formatting funcitons
'
'
Dim rng As Word.Range
Set rng = doc.Range
With rng.Find
.text = txt
.Forward = True
.Execute
End With
Set fndtxt = rng
End Function
样式功能
Public Function Style(txt As Word.Range, stylename As String) As Object
'
' A function to apply styles to ranges
'
'
Dim myRange As Word.Range
Set myRange = txt
myRange.Style = stylename
End Function
这在很大程度上归结为添加了这个词。在靶场前面。
下面是一个包含Excel端所有代码的基本示例:
Sub Tester()
Dim wdApp As Word.Application, doc As Word.Document, rng As Word.Range
Set wdApp = GetObject(, "Word.Application") 'in my testing word is already open
Set doc = wdApp.Documents.Add()
With doc
.Content.ParagraphFormat.SpaceBefore = 0
.Content.ParagraphFormat.SpaceAfter = 0
.Content.InsertAfter "Internal Wiki"
SetTextStyle doc, "Internal Wiki", "Title"
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
End With
End Sub
Sub SetTextStyle(doc As Word.Document, txt As String, theStyle As String)
Dim rng As Word.Range
Set rng = WordTextRange(doc, txt)
If Not rng Is Nothing Then
rng.style = theStyle
Else
MsgBox "'" & txt & "' was not found", vbExclamation
End If
End Sub
'return a range containing the text `txt` in document `doc`
' returns Nothing if no match is made
Function WordTextRange(doc As Word.Document, txt As String) As Word.Range
Dim rng As Word.Range
Set rng = doc.Range
With rng.Find
.Text = txt
.Forward = True
If .Execute() Then 'check that Execute succeeds...
Set WordTextRange = rng
End If
End With
End Function