Question

我需要帮助理解为什么我在Ln82上不断出现“需要对象”的错误。我以为你可以在字典中存储任何东西？

工作流程为：

启动程序
创建临时项目词典以循环输入框
稍后使用此词典将所有用户输入存储为范围
调用子例程以打开目标文档（Mysupes）
调用子例程以开源excel wb（警报）
提示用户12次（通过循环）选择source excel中的范围
粘贴到目标词doc（此时我不在乎哪里，我只需要粘贴该死的东西）

另外请忽略任何评论，这只是我的划痕工作，我尝试了不同的途径。

Sub AlertToSupes()

'Declarations
Dim MyAlert As String
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
'Dim key As Variant
Dim v As Long
Dim r As Variant
Dim Mysupes As Document
'Mysupes.Visible = True
'Dim AlertToSupeData As Object
Application.ScreenUpdating = True


'Collection of objects to get from Alert doc and paste into Supes
'Dim colSupesData As Collection
'Set colSupesData = New Collection
'    colSupesData.Add "Project team names"
'    colSupesData.Add "Programming"
'    colSupesData.Add "Date(today)"
'    colSupesData.Add "Subject(Blind study name in Alert)"
'    colSupesData.Add "LRW job#"
'    colSupesData.Add "LOI"
'    colSupesData.Add "Incidence"
'    colSupesData.Add "Sample size"
'    colSupesData.Add "Dates(select from Alert)"
'    colSupesData.Add "Devices allowed"
'    colSupesData.Add "Respondent qualifications(from Alert)"
'    colSupesData.Add "Quotas"


'Dictionary of attributes(alternative to list)
dict.Add "Project team names", ""
dict.Add "Programming", ""
dict.Add "Date(today)", ""
dict.Add "Subject(Blind study name in Alert)", ""
dict.Add "LRW job#", ""
dict.Add "LOI", ""
dict.Add "Incidence", ""
dict.Add "Sample size", ""
dict.Add "Dates(select from Alert)", ""
dict.Add "Devices allowed", ""
dict.Add "Respondent qualifications(from Alert)", ""
dict.Add "Quotas", ""

'Open up the Supes

Call OpenSupes


'Open up the Alert file
MyAlert = Application.GetOpenFilename()
Workbooks.Open (MyAlert)

'Loop for subroutine
For Each key In dict.keys
    Debug.Print (key)
    Call Cpy(key)
    dict.item = r.Value
Next key   
End Sub

Sub Cpy（键为变体）

'Loop that asks for user-defined input for every field of Supes
Dim r As Range, LR As Long
Dim Mysupes As Object



On Error Resume Next
Set r = Application.InputBox("Select the cell that contains " & key, Type:=8)
On Error GoTo 0
If r Is Nothing Then Exit Sub
'LR = Cells(Rows.Count, r.Column).End(xlUp).Row
'Range(Cells(5, r.Column), Cells(LR, r.Column)).Copy Destination:=Cells(5, r.Column + 1)


r.Copy
With Mysupes
    'AppWord.Documents.Add
    AppWord.Selection.PasteExcelTable
    Application.CutCopyMode = False
    'Set MySupes = Nothing
End With    
End Sub

Sub OpenSupes（）

'Dim Mysupes As Object
Dim wordapp As Object
Dim Mysupes As FileDialog


Set wordapp = CreateObject("word.Application")
Set Mysupes = Application.FileDialog( _
FileDialogType:=msoFileDialogOpen)
Mysupes.Show
'Set Mysupes = wordapp.Documents.Open("\\10.1.11.169\LRW\Field (New)\01 Admin\02 Standard Documents\01 Supes\Supes Memo - Online Study.dotx")
wordapp.Visible = True


End Sub

Answer 1

代码存在许多问题。

1）关键一点是您尝试在Word文档上使用Workbooks.Open方法。 [Workbooks.Open][1]期望一个工作簿变量。所以这个：

 Workbooks.Open (MyAlert)

不能使用Word文档。

您需要Documents.Open但还需要Word应用程序才能使用它，因此您需要在相应的子目录中创建该应用程序实例。您可以使用wordapp.Documents.Open

在其他位置执行此操作

2）使用代码顶部的Option Explicit并声明所有变量。整个过程都有缺失。

3）打开应用程序后退出应用程序，或者最终因为运行实例太多而崩溃。

4）Application.ScreenUpdating = True应位于sub的末尾以更新屏幕，并且只有在此之前您有Application.ScreenUpdating = False。

5）正如@CindyMeister所说：你不应该On Error Resume Next InputBox左右begin dbms_stats.gather_table_stats(user, 'CONFIRM'); dbms_stats.gather_table_stats(user, 'INVOICE_CONFIRM'); dbms_stats.gather_table_stats(user, 'PERSON'); end; /。您可以通过将结果设置为变量并对其进行测试来进行测试。请参阅Trouble with InputBoxes

6）@dbmitch说的是什么。功能转换将是一个合理的选择。

Answer 2

您尝试将r.Value分配给字典时，您的循环内部会生成您报告的错误

For Each key In dict.keys
    Debug.Print (key)
    Call Cpy(key)
    dict.item = r.Value
Next key

您假设Cpy子程序正在将r单元格发送回您的程序，但它不是 - r在你的程序中作为变量和本地声明在Cpy中作为范围。

您需要将r作为函数值而不是闭合子例程返回，或者你可以将r Range类型变量设为全局变量，以便所有程序都可以看到它

所需对象：Excel＆amp; Word VBA，词典和存储范围

Sub Cpy（键为变体）

Sub OpenSupes（）

2 个答案: