Мне нужна помощь в понимании того, почему я продолжаю получать ошибку "Требуется объект" на Ln82. Я думал, что вы можете хранить что-нибудь в словаре?
Рабочий процесс:
- Запустить программу
- Создать словарь временных элементов для циклического перебора поля ввода
- Используйте этот словарь позже, чтобы сохранить все введенные пользователем данные как диапазоны
- Вызов подпрограммы, чтобы открыть целевой документ (Mysupes)
- Вызов подпрограммы для open source excel wb (Alert)
- Запрос пользователя 12 раз (с помощью цикла) на выбор диапазонов в источнике Excel
- Вставить в слово назначения документа (на данный момент мне все равно, где, мне просто нужно вставить эту чертову вещь)
Также, пожалуйста, игнорируйте любые комментарии, это просто моя работа, где я пробовал разные пути.
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