ListRows.Add не работает

Sean Leisk спросил: 03 февраля 2018 в 01:17 в: vba

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

Я пытаюсь запустить функцию, чтобы вернуть список данных в строке, разделенной точкой с запятой от оракула хранимая функция. (Похоже, что этот вызов функции функций работает нормально). Я затем перебираю строку для каждого значения данных и печатаю ее в пустую таблицу (0 строк), объявленную в моей подпрограмме. который я использую для загрузки в базу данных доступа. (просто верьте, что это имеет смысл в большой картине ...).

Проблема в том, что в таблицу не печатается никакой информации. Однако, когда я просматриваю код, он отлично работает.

После устранения неполадок я THINK (см. Мои тестовые сценарии ниже кода) проблема возникает после строки listrows.add ... хотя и не очевидно . Я не думаю, что эта строка выполняется к моменту, когда первое значение пытается печатать в таблице.

Самая запутанная часть - это то, что я выполняю две почти идентичные процедуры (функция вызова - > , Возвращаемое значение - > печатать значения в таблице) непосредственно перед этой частью кода, и они работают без сбоев.

Код:

'run function to get string ... this works
DoEvents ' not in original design
RelRtnStr = Prnt(Cat, "A Third Oracle Function Name")
DoEvents ' not in original design
RelChopVar = RelRtnStrStrFldCnt = 0
Checking = True ''' CodeBreak Test 1DoEvents ' not in original design
AppendRlLmTbl.ListRows.Add ''''''''This isn't appearing to work...
DoEvents ' not in original design
Debug.Print Now ' not in original design
Application.Wait (Now + TimeValue("0:00:3")) ' not in original design
Debug.Print Now ' not in original design
While StrFldCnt < 80 And (Len(RelChopVar) - Len(Replace(RelChopVar, ";", ""))) > 0 And Checking
'## Count String Position
    StrFldCnt = StrFldCnt + 1
'## Find Current String Value & Remainder String
    If InStr(RelChopVar, ";") <> 0 Then
    'Multiple Values Left
        FldVal = Replace(Left(RelChopVar, InStr(RelChopVar, ";")), ";", "")
        RelChopVar = Right(RelChopVar, Len(RelChopVar) - InStr(RelChopVar, ";"))
    Else
    'Last Value
        FldVal = RelChopVar
        Checking = False
    End If
'## Get Field Name For Current Value & Print to Table
    FldNm = CStr(RefRtrn(2, CStr(StrFldCnt))) ''' CodeBreak Test 2
    AppendRlLmTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal  '''CodeBreak 2 error thrown
    Debug.Print StrFldCnt & FldNm & FldVal
Wend
AppendRlLmTbl.ListColumns("Catalogue").DataBodyRange.Value = Cat

До сих пор Я тестировал тонну вариантов, предлагаемых в Интернете, не обязательно понимая каждый тест ... Это то, что я почерпнул.

  1. Если я пройду через код, он будет работать

  2. Если я установил точку останова в "CodeBreak Test 1" и "F5", остальные будут работать ...

  3. Если я установить точку останова в "CodeBreak Test 2". Я получаю объект " с переменной, не установленной ", созданной ошибкой ...

Вещи, которые я пробовал ...

  1. Обертка nything и все с DoEvents

  2. установка времени ожидания после строки listObjects.add

  3. Проверено, что код выполняет цикл While при запуске "полной закупки" (в отличие от перехода)

Худшая часть, я понятия не имею, почему объект не будет корректно объявляться при установке точки прерывания после строки строки добавления, но правильно устанавливается, когда точка останова задана раньше, и при запуске полной процедуры не возникает ошибка (у меня нет сообщений об ошибках.) ...

Это, конечно, должно быть связано с моим мнением, но я не могу найти какую-либо информацию в Интернете и, к сожалению, не имею формального фона VBA и 1 курс обучения в качестве основы программирования в целом. Ака, я не в своей глубине и супер разочарован. PS. первый пост, поэтому, пожалуйста, будьте милы: p

Полный код ниже:

 Option Explicit
 '## Here's my attempt to clean up and standardize the flow
 '## Declare my public variables
 ' WorkBook
 Public WB As Workbook
 ' Sheets
 Public Req2ByWS As Worksheet
 Public ReqSpecsWS As Worksheet
 Public ReqInstrcWS As Worksheet
 Public ConfigReqWS As Worksheet
 Public AppendReqWS As Worksheet
 Public AppendRlLmWS As Worksheet
 ' Objects (tables)
 Public ReqConfigTbl As ListObject
 Public SpecConfigTbl As ListObject
 Public CurrRegIDTbl As ListObject
 Public AppendReqTbl As ListObject
 Public AppendRlLmTbl As ListObject '## ##
 '## Get Data from Tom's Functions ##
 Sub GetSpotBuyData() '## Preliminary Config ##
 '## Turn OFF Warnings & Screen Updates
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
 '## Set global Referances to be used in routine
    ' WorkBooks
    Set WB = Workbooks("MyWb.xlsm")
    ' WorkSheets
    Set Req2ByWS = WB.Sheets("MyWb Pg1")
    Set ReqSpecsWS = WB.Sheets("MyWb Pg2")
    Set ConfigReqWS = WB.Sheets("MyWb Pg3")
    Set AppendReqWS = WB.Sheets("MyWb Pg4")
    Set AppendRlLmWS = WB.Sheets("MyWb Pg5")
    ' Tables
    Set ReqConfigTbl = ConfigReqWS.ListObjects("MyWS Tbl1")
    Set SpecConfigTbl = ConfigReqWS.ListObjects("MyWS Tbl2")
    Set CurrRegIDTbl = ConfigReqWS.ListObjects("MyWS Tbl3")
    Set AppendReqTbl = AppendReqWS.ListObjects("MyWS Tbl4")
    Set AppendRlLmTbl = AppendRlLmWS.ListObjects("MyWS Tbl5")
 '## Declare Routine Specefic Variables
    Dim Doit As Variant
    Dim Checking As Boolean
    Dim Cat As String
    Dim CatRtnStr As String
    Dim CatChopVar As String
    Dim SpecRtnStr As String
    Dim SpecChopVar As String
    Dim RelRtnStr As String
    Dim RelChopVar As String
    Dim FldVal As String
    Dim FldNm As String
    Dim StrFldCnt As Integer '## 1) General Set-Up ##
 '## Unprotect tabs (loop through All Tabs Unprotect)
    Doit = Protct(False, WB, "Mypassword")
 '## Refresh Data
    Doit = RunUpdateAl(WB) '## 2) Find the Catalgue we are playing with ##
 '## Grab Catalogue input from ISR
    If [Catalogue].Value = "" Then
        MsgBox ("Please Enter a Catalogue")
        GoTo ExitSub
    Else
        Cat = [Catalogue].Value
    End If '## 3) Run Toms Function and print the results to the form & Append Table ##
 '## 3a) Do it for Cat Info Function
 '## Get Cat Info String From Function
    CatRtnStr = Prnt(Cat, "An Oracle Functions Name")
    CatChopVar = CatRtnStr
    If CatChopVar = "No Info" Then
        MsgBox ("No Info Found in Catalogue Data Search.")
        GoTo SkipCatInfoPrint
    End If
 '## Loop Through Data String & Write to Form
    StrFldCnt = 0
    Checking = True
    AppendReqTbl.ListRows.Add
    While Checking
    '## Count String Position
        StrFldCnt = StrFldCnt + 1
    '## Find Current String Value & Remainder String
        If InStr(CatChopVar, ";") <> 0 Then
        'Multiple Values Left
            FldVal = Replace(Left(CatChopVar, InStr(CatChopVar, ";")), ";", "")
            CatChopVar = Right(CatChopVar, Len(CatChopVar) - InStr(CatChopVar, ";"))
        Else
        'Last Value
            FldVal = CatChopVar
            Checking = False
        End If
    '## Get Field Name For Current Value & Print to Form
        FldNm = CStr(RefRtrn(1, CStr(StrFldCnt)))
        If FldNm <> "CustomerSpecification" And FldNm <> "ShiptoAddress" Then
        'Take Value as is
            Req2ByWS.Range(FldNm).Value = FldVal
            AppendReqTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal
        ElseIf FldNm = "CustomerSpecification" Then
        'Replace : with New Line
            FldVal = Replace(FldVal, " : ", vbLf)
            Req2ByWS.Range(FldNm).Value = FldVal
            AppendReqTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal
        ElseIf FldNm = "ShiptoAddress" Then
        'Replace - with New Line
            FldVal = Replace(FldVal, " - ", vbLf)
            Req2ByWS.Range(FldNm).Value = FldVal
            AppendReqTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal
        End If
    Wend
 '## 3b) Do it for Spec Function
 SkipCatInfoPrint:
 '## Get Spec Info String From Function
    SpecRtnStr = Prnt(Cat, "Another Oracle Functions Name")
    SpecChopVar = SpecRtnStr
    If SpecChopVar = "No Info" Then
        MsgBox ("No Info Found in  Data Search.")
        GoTo SkipSpecInfoPrint
    End If
 '## Loop Through Data String & Write to Form
    StrFldCnt = 0
    Checking = True
    While StrFldCnt < 80 And (Len(SpecChopVar) - Len(Replace(SpecChopVar, ";", ""))) > 0 And Checking
    '## Count String Position
        StrFldCnt = StrFldCnt + 1
    '## Find Current String Value & Remainder String
        If InStr(SpecChopVar, ";") <> 0 Then
        'Multiple Values Left
            FldVal = Replace(Left(SpecChopVar, InStr(SpecChopVar, ";")), ";", "")
            SpecChopVar = Right(SpecChopVar, Len(SpecChopVar) - InStr(SpecChopVar, ";"))
        Else
        'Last Value
            FldVal = SpecChopVar
            Checking = False
        End If
    '## Get Field Name For Current Value & Print to Form
        FldNm = CStr(RefRtrn(2, CStr(StrFldCnt)))
        ReqSpecsWS.Range(FldNm).Value = FldVal
        AppendReqTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal
    Wend
 '## 3c) Do it for Rel Limits Function
 SkipSpecInfoPrint:
 '## Get Rel Limits String From Function
    RelRtnStr = Prnt(Cat, "A Third Functions Name")
    RelChopVar = RelRtnStr
    If RelChopVar = "No Info" Then
        MsgBox ("No Info Found in Data Search.")
        GoTo ExitSub
    End If
 '## Loop Through Data String & Write to Form
    StrFldCnt = 0
    Checking = True    AppendRlLmTbl.ListRows.Add
    While StrFldCnt < 80 And (Len(RelChopVar) - Len(Replace(RelChopVar, ";", ""))) > 0 And Checking
    '## Count String Position
        StrFldCnt = StrFldCnt + 1
    '## Find Current String Value & Remainder String
        If InStr(RelChopVar, ";") <> 0 Then
        'Multiple Values Left
            FldVal = Replace(Left(RelChopVar, InStr(RelChopVar, ";")), ";", "")
            RelChopVar = Right(RelChopVar, Len(RelChopVar) - InStr(RelChopVar, ";"))
        Else
        'Last Value
            FldVal = RelChopVar
            Checking = False
        End If
    '## Get Field Name For Current Value & Print to Form
        FldNm = CStr(RefRtrn(2, CStr(StrFldCnt)))
        AppendRlLmTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal
    Wend
    AppendRlLmTbl.ListColumns("SpecificFieldName").DataBodyRange.Value = Cat
 '## 4) Re-Format and Clean Up Program ##
 ExitSub:
 '## Clean-Up Formatting
    Req2ByWS.Range("F:F", "C:C").ColumnWidth = 30
    Req2ByWS.UsedRange.Rows.AutoFit
    Req2ByWS.UsedRange.Columns.AutoFit
    Req2ByWS.Range("G:G").ColumnWidth = 15
    Req2ByWS.Range("J:R").ColumnWidth = 12
    Req2ByWS.Range("D:D").ColumnWidth = 12
 '## Protect tabs (loop through All Tabs Protect)
    'Doit = Protct(True, WB, "Mypassword", Req2ByWS.Name)
    'Req2ByWS.Unprotect ("Mypassword")
    'Application.Wait (Now + TimeValue("0:00:10"))
    Req2ByWS.Select
 '## Turn ON Warnings & Screen Updates
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 End Sub

0 ответов