Требуемый объект: Excel и Word VBA, словари и диапазоны хранения. - PullRequest
0 голосов
/ 01 мая 2018

Мне нужна помощь в понимании того, почему я продолжаю получать ошибку "Требуется объект" на Ln82. Я думал, что вы можете хранить что-нибудь в словаре?

Рабочий процесс:

  1. Запустить программу
  2. Создать словарь временных элементов для циклического перебора поля ввода
  3. Используйте этот словарь позже, чтобы сохранить все введенные пользователем данные как диапазоны
  4. Вызов подпрограммы, чтобы открыть целевой документ (Mysupes)
  5. Вызов подпрограммы для open source excel wb (Alert)
  6. Запрос пользователя 12 раз (с помощью цикла) на выбор диапазонов в источнике Excel
  7. Вставить в слово назначения документа (на данный момент мне все равно, где, мне просто нужно вставить эту чертову вещь)

Также, пожалуйста, игнорируйте любые комментарии, это просто моя работа, где я пробовал разные пути.

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

Ответы [ 2 ]

0 голосов
/ 01 мая 2018

Ошибка, о которой вы сообщаете, генерируется внутри вашего цикла, когда вы пытаетесь назначить значение r.Value для своего словаря

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

Вы предполагаете, что подпрограмма Cpy отправляет ячейку r обратно в вашу программу, но это не так - r объявлен локально в вашей программе как вариант и локально внутри Cpy как Range.

Вам нужно вернуть r в качестве значения функции вместо закрытой подпрограммы, или вы можете сделать переменную типа Range глобальной, чтобы ее могли видеть все ваши программы

0 голосов
/ 01 мая 2018

Существует множество проблем с кодом.

1) Ключевым моментом является то, что вы пытаетесь использовать метод Workbooks.Open в документе Word. [Workbooks.Open][1] ожидает переменную книги. Итак, это:

 Workbooks.Open (MyAlert)

не будет работать с документом Word.

Вы хотите Documents.Open, но вам также нужно приложение Word для его использования, поэтому вам нужно будет создать этот экземпляр приложения в соответствующем подпрограмме. Вы делаете это в другом месте с wordapp.Documents.Open

2) Используйте Option Explicit вверху вашего кода и объявите все свои переменные. Повсюду пропали.

3) Завершите работу приложений после их открытия, или в результате чего-то произойдет сбой из-за слишком большого количества запущенных экземпляров.

4) Application.ScreenUpdating = True должен находиться в конце подпрограммы для обновления экрана и только если до этого у вас было Application.ScreenUpdating = False.

5) Как отмечает @CindyMeister: вам не нужно On Error Resume Next около InputBox. Вы можете проверить, установив результат для переменной и протестировав его. См. Проблема с полями ввода

6) И что сказал @dbmitch. Преобразование функций было бы логичным выбором.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...