Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/15.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181

Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/28.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Vba ListRows.Add不';似乎不起作用_Vba_Excel_Listobject - Fatal编程技术网

Vba ListRows.Add不';似乎不起作用

Vba ListRows.Add不';似乎不起作用,vba,excel,listobject,Vba,Excel,Listobject,我有一个非常奇怪的案例…希望有人能帮助我,我已经搜索了许多论坛寻找解决方案,我能找到的最接近它(有点)的是,虽然我尝试了所有的建议都没有用 我试图运行一个函数,从oracle存储函数返回一个以分号分隔的字符串中的数据列表。(此值函数调用似乎工作正常)。 然后循环遍历每个数据值的字符串,并将其打印到子程序中声明的空白表(0行)。我用它来加载access数据库。(只要相信它在大局中是有意义的…) 从根本上说,问题在于没有信息打印到表中。但是,当我逐步完成代码时,它工作得很好 排除故障后,我认为(请参

我有一个非常奇怪的案例…希望有人能帮助我,我已经搜索了许多论坛寻找解决方案,我能找到的最接近它(有点)的是,虽然我尝试了所有的建议都没有用

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

从根本上说,问题在于没有信息打印到表中。但是,当我逐步完成代码时,它工作得很好

排除故障后,我认为(请参见下面代码中的测试场景)问题出现在
列表行之后。添加
行。。。虽然不是很明显。
我认为当第一个值试图打印到表中时,不会执行这一行

最让人困惑的是,在代码的这一部分之前,我正在运行两个几乎相同的过程(调用函数->返回值->将值打印到表),它们工作正常

代码摘录:

'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

我愚蠢地为那个特定的表启用了后台刷新。刷新所有数据的早期调用触发了刷新,代码将执行,并且在代码完成执行后不久,刷新将最终完成。。。在中断模式下,刷新也将提前完成。感谢PEH帮助我了解这一点。

如果有必要,我会从表单控件按钮运行该过程……您能在问题中显示什么是
AppendRlLmTbl
吗?它是一个listobject变量,设置为我的工作簿集合AppendRlLmWS=WB.Sheets(“AppendRelLimTbl”)集合AppendRlLmTbl=AppendRlLmWS.ListObjects中的特定表(“appendrlimtbl”)我看不出
有任何错误。添加
。只是为了确保有任何错误处理(
下一步错误恢复时
)在该子项中?您是否可以在问题中现有代码的基础上添加原始完整子项,以查看在此之前是否存在异常情况?是否存在
工作表\u更改
事件(或任何其他事件)在那张可能会产生干扰的工作表中?是你要求的,我可以定期检查问题。我很感激你能提供的任何见解,你可以在一段时间后接受自己的答案作为解决方案。
 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