ListRows.Add似乎不起作用

时间：2022-08-22 17:13:07

I've got a really odd case… hopefully someone is able to help me out, I've search many forums looking for a solution, the closest I could find related to it (kinda) is here, though I've tried all the suggestions to no avail…

我有一个非常奇怪的案例...希望有人能够帮助我,我已经搜索了许多论坛寻找解决方案,我能找到的最接近它(有点)就在这里,虽然我已经尝试了所有的建议无济于事......

I'm trying to run a function to return a data list in a string delimitated by a semicolon from an oracle stored function. (This value function call seems to work fine).
I then loop through the string for each data value and print it to a blank table (0 rows) declared in my subroutine. which I use to load into an access data base. (just trust it make sense in the big picture…).

我正在尝试运行一个函数来返回由oracle存储函数中的分号分隔的字符串中的数据列表。 (这个值函数调用似乎工作正常)。然后,我遍历每个数据值的字符串,并将其打印到我的子例程中声明的空白表(0行)。我用它加载到访问数据库。 (只是相信它在大局中有意义......)。

The issue, fundamentally is that no information is printed into the table. However when I step through the code it works fine.

问题,从根本上说,没有信息打印到表中。但是,当我单步执行代码时,它工作正常。

After troubleshooting I THINK (see my test scenarios below code) the issue comes up after the listrows.add line... though not obviously. I don't think this line is executed by the time the first value is trying to print to the table.

排除故障后我认为(请参阅我的测试方案下面的代码)问题出现在listrows.add行之后......虽然不是很明显。我不认为这行是在第一个值尝试打印到表时执行的。

The most confusing part is I'm running through 2 nearly identical procedures (call function -> Return value -> print values to table) immediately before this portion of the code and they work without fail.

最令人困惑的部分是我在代码的这一部分之前运行了两个几乎完全相同的程序(调用函数 - >返回值 - >打印值到表),它们的工作没有失败。

Code Excerpt:

'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 = RelRtnStr

StrFldCnt = 0
Checking = True ''' CodeBreak Test 1

DoEvents ' 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

So far I've tested a ton of options suggested online, not necessarily understanding each test... This is what I've gleaned.

到目前为止,我已经测试了大量在线建议的选项,不一定了解每个测试...这就是我收集的内容。

  1. If I step through the code, it works

    如果我单步执行代码,它就可以运行

  2. If I set a breakpoint at "CodeBreak Test 1" and "F5" the rest, it works …

    如果我在“CodeBreak Test 1”和“F5”设置断点,那么它可以工作......

  3. If I set a breakpoint at "CodeBreak Test 2" I get an "Object with variable not set" error thrown …

    如果我在“CodeBreak Test 2”中设置断点,我会得到一个“未设置变量的对象”错误...

Things I've tried …

我试过的事情......

  1. Wrapping anything and everything with DoEvents

    使用DoEvents包装任何内容和所有内容

  2. setting a wait time after the listObjects.add row

    在listObjects.add行之后设置等待时间

  3. Validated the code performs the While loop when running the "full procured" (as opposed to stepping through)

    验证代码在运行“完全采购”时执行While循环(而不是单步执行)

The worst part, I have no idea why the object won't declare properly when setting a break point after the add row line but sets properly when break point is set before and has no error thrown when running the full procedure (I have no on error declarations.)...

最糟糕的是,我不知道为什么在添加行行之后设置断点时对象不能正确声明,但是在设置断点之前正确设置并且在运行完整过程时没有抛出错误(我没有打开)错误声明。)...

It of course must be related in my mind but I can't find any information online and unfortunately have no formal VBA background and 1 undergrad course as a programming background in general. Aka I'm out of my depth and super frustrated.

它当然必须与我的想法有关,但我无法在网上找到任何信息,遗憾的是,没有正式的VBA背景和1个本科课程作为编程背景。阿卡我超出了我的深度并且非常沮丧。

PS. first post, so please be nice :p

PS。第一篇文章,所以请你好:p

Full Code Below:

完整代码如下:

 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

1 个解决方案

#1

1  

I stupidly had an enable background refresh for that specific table. An early call to refresh all data triggered the refresh, code would execute and the refresh would finally complete shortly after the code finished executing... in break mode the refresh would complete prior too. Thanks PEH for helping me look into this.

我愚蠢地为该特定表启用了后台刷新功能。早期调用刷新所有数据触发刷新,代码将执行,刷新最终将在代码完成执行后不久完成...在中断模式下,刷新也将在之前完成。感谢PEH帮助我调查此事。

#1

1  

I stupidly had an enable background refresh for that specific table. An early call to refresh all data triggered the refresh, code would execute and the refresh would finally complete shortly after the code finished executing... in break mode the refresh would complete prior too. Thanks PEH for helping me look into this.

我愚蠢地为该特定表启用了后台刷新功能。早期调用刷新所有数据触发刷新,代码将执行,刷新最终将在代码完成执行后不久完成...在中断模式下,刷新也将在之前完成。感谢PEH帮助我调查此事。

标签：

相关文章