Вызванный объект Excel VBA отключился от своих клиентов - PullRequest
Новая
       10

Вызванный объект Excel VBA отключился от своих клиентов

0 голосов
/ 05 февраля 2020

Итак, я работаю над формой пользователя, чтобы извлечь данные из разных таблиц Excel и создать сводную таблицу на основе пользовательских данных. Все это находится в одной книге без внешних ссылок, и большинство решений, которые я видел для этой ошибки, являются результатом попытки подключить / открыть внешний источник. Код работает до тех пор, пока не достигнет десятой записи, затем он дает мне сообщение «Вызванный объект отключился от ошибки клиента» и перезапускает Excel. Я попытался закомментировать десятую запись, и та же ошибка возникает через другой интервал. 

Private Sub Submit_Click()


If TextBox_1.Value > 0 Then

   Worksheets("FirstSheet").UsedRange.Offset(3).Resize(Worksheets("FirstSheet").UsedRange.Rows.Count - 3).Copy
   Worksheets("Template").Rows("4").Insert shift:=xlDown

End If

If TextBox_2.Value > 0 Then

   Worksheets("SecondSheet").UsedRange.Offset(3).Resize(Worksheets("SecondSheet").UsedRange.Rows.Count - 3).Copy
   Worksheets("Template").Rows("4").Insert shift:=xlDown

End If

If TextBox_3.Value > 0 Then

   Worksheets("ThirdSheet").UsedRange.Offset(3).Resize(Worksheets("ThirdSheet").UsedRange.Rows.Count - 3).Copy
   Worksheets("Template").Rows("4").Insert shift:=xlDown

End If

...

If TextBox_9.Value > 0 Then

   Worksheets("NinthSheet").UsedRange.Offset(3).Resize(Worksheets("NinthSheet").UsedRange.Rows.Count - 3).Copy
   Worksheets("Template").Rows("4").Insert shift:=xlDown

End If

**If TextBox_10.Value > 0 Then
   Worksheets("TenthSheet").UsedRange.Offset(3).Resize(Worksheets("TenthSheet").UsedRange.Rows.Count - 3).Copy
   Worksheets("Template").Rows("4").Insert shift:=xlDown
End if**

Является ли проблема следствием количества повторений в коде? Есть ли конкретный элемент c в самом листе, который я должен искать, который вызвал бы эту проблему?

Ответы [ 2 ]

1 голос
/ 06 февраля 2020

Вам не нужно указывать каждый лист отдельно, вы можете использовать al oop вот так 

Option Explicit
Private Sub Submit_Click()

    Dim wb As Workbook, wsSource As Worksheet, wsTarget As Worksheet
    Set wb = ThisWorkbook
    Set wsTarget = wb.Sheets("Template")

    Dim sheetnames As Variant
    sheetnames = Array("", "FirstSheet", "SecondSheet", "ThirdSheet", "ForthSheet", _
    "FifthSheet", "SixthSheet", "SeventhSheet", "EighthSheet", "NinthSheet", "TenthSheet")

    Dim n As Integer, sName As String, sValue As String
    Dim rngSource As Range, rngTarget As Range

    Application.ScreenUpdating = False
    For n = 1 To UBound(sheetnames)
        sName = "TextBox_" & CStr(n)
        sValue = Me.Controls(sName)
        If Len(sValue) > 0 Then

            ' define ranges
            Set wsSource = wb.Sheets(sheetnames(n))
            Set rngSource = wsSource.UsedRange.Offset(3).Resize(wsSource.UsedRange.Rows.Count - 3)
            Set rngTarget = wsTarget.Rows(4)

            ' copy to Template
            rngSource.Copy
            rngTarget.Insert shift:=xlDown
            Application.CutCopyMode = False

        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Finished", vbInformation
End Sub
0 голосов
/ 06 февраля 2020

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

Private Sub Submit_Click()

Dim Template As Range
Dim FirstSheet As Range

Set Template = Worksheets(2).Range("$A$4")
Set FirstSheet = Worksheets(3).UsedRange.Offset(3).Resize(Worksheets(3).UsedRange.Rows.Count - 3)

If TextBox_1.Value > 0 Then

   FirstSheet.Copy
   Template.Insert shift:=xlDown

End If
...