none
Posloupnost volaných procedur a funkcí ve VBA RRS feed

  • Dotaz

  • Ahoj,

    mám napsaný program, ve kterém mám postupné úrovně zanořování do různých modulů. Vznikl mě problém, že po ukončení jedné funkce, se běh makra nevrátí do volané procedury, ale vrátí se o úroveň výše. Detail níže:

    1. Module1 - makro 1
    2. UserForm - code - volání makra2
    3. Module2 - makro 2 - volá funkci1
    4. Module3 - funkce1

    Po vykonání bodu 4 (vrácení hodnoty z funkce), by se měl kód vrátit na následující řádek v proceduře, z které byla funkce vyvolána. V našem případě je to návrat do bodu 3. ve skutečnosti dojde k návratu do bodu 2, tj., do procedury, která je součáístí vyvoláného UserFormu.

    OTÁZKA: Dá se nějak ošetřit to, aby po ukončení bodu 4 proběhl návrat do bodu 3 ( a ne do bodu2)?


    VALL2

    čtvrtek 25. července 2013 6:43

Odpovědi

  • tak jsem na to přišel. v sub 4 to vrátilo 2 záznamy a to způsobilo pád. takže jsem to opravil a vše funguje v pořádku.

    VALL2

    • Označen jako odpověď VALL2 čtvrtek 5. září 2013 9:42
    čtvrtek 5. září 2013 9:42

Všechny reakce

  • Asi by to chtelo konkretni ukazky kodu. Mam zkusenost (your mileage may vary), ze takto se VBA chova napr. pri neodchytitelne chybe ve volane externi komponente, kdy jsou ignorovany vsechny error trapy a proste se ukonci aktualni sub()

    MP

    čtvrtek 25. července 2013 7:04
    Moderátor
  • ok, pokusím se níže uvést.

    1. Výchozí makro, které zavolá UserForm:

    Sub VlozeniDoTermPrehled()
     
    Dim Projekt As String
     Projekt = Range("hlp_ProjektL5").Text
     sSQL = "nějaký řetězec"
    
      If SqlBoolean(sSQL) = "NOK" Then     'Volání funkce, která vrátí textový řetězec'
         uf_NoveProjekty.Show              'vyvolání UserFormu, kde se doplní informacia uloží do Db'
    
      End If
    End Sub

    2. v UserFormu se doplní informace a po kliku se volá procedura, která vkládá data do Db

    Private Sub cmb_OK_Click()
        Call NovyZaznamSql(Partak, TypProjektu) 'Následují makro'
        Unload Me
    
    End Sub

    3. Makro, pomocí kterého vkládám data do Db

    Sub NovyZaznamSql(Partak, TypProjektu)
    Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long, MyConn As String
    
     Set cn = New ADODB.Connection
     MyConn = "Connection string do SQL"
    
    cn.Provider = "Microsoft.Jet.OLEDB.4.0"
          cn.Open MyConn
          
     Set rs = New ADODB.Recordset
       
    'Zápis do SQL'
       rs.Open "Tabulka1", cn, adOpenKeyset, adLockOptimistic, adCmdTable
       
    Dim ID_mainprojekt As Integer
    Dim Modul As String
     sSQL = "SELECT ID " & _
            "FROM Tabulka1 " & _
            "WHERE Projekt = 'Projekt123' "
     
     ID_mainprojekt = strSqlSelect(sSQL)  'Zde kritické místo - volá se funkce, kde se kód po zkončení nevrátí na řádek With, ale do procedury v USerFormu'
                
      With rs
          .AddNew
          .Fields("ID_mainprojekt") = ID_mainprojekt
          .Fields("Btool") = List5.Cells(i, "G").Text
          .Update
          .Close
      End With
    
      Set rs = Nothing
      cn.Close
      Set cn = Nothing
    
    End Sub

    4. Funkce, pomocí které vrátím text, který potřebuji vložit do Db. Vazba na bod 3.

    ublic Function strSqlSelect(sSQL) As String
    'Vrátí data dle selectu'
    
    Dim cnn As ADODB.Connection, rst As ADODB.Recordset
    Dim MyConn
        
      Set cnn = New ADODB.Connection
      Set rst = New ADODB.Recordset
      
    MyConn = "connection string"
             
      cnn.Provider = "Microsoft.Jet.OLEDB.4.0"
      cnn.Open MyConn
      
      rst.CursorLocation = adUseServer
      rst.Open Source:=sSQL, ActiveConnection:=cnn, CursorType:=adOpenKeyset, LockType:=adLockOptimistic
      
    'Vrácení hodnoty ze SELECTU'
     On Error Resume Next
       SqlSelekt = rst.GetString
       If Err.Number = 3021 Then SqlSelekt = ""
    
        rst.Close
        cnn.Close
        Set rst = Nothing
        Set cnn = Nothing
    End Function


    VALL2

    čtvrtek 25. července 2013 8:06
  • JJ, jak uz jsem psal - presne takto se VBA chova, pokud dojde k padu v externi komponente (ve tvem pripade ActiveX Data Objects ....)

    Navic ti chybi err.clear za   If Err.Number = 3021 Then SqlSelekt = "" (i kdyz ja bych testoval zda err.number <>0)

    Nicmene doporucuju si to hezky odkrokovat kde to zbachne.

    Priznam se, ze jsem neprisel na lepsi reseni, nez globalni semafor typu AsiSeNecoPose.e, ktery pred volanim externi funkce / procedury nastavim na True a na radku bezprostredne nasledujicim na False. Takze pokud mi to zbachne tak aspon v nadrazene subce vim, ze to zbachlo. Fuj.  Napiste nekdo, jak to udelat lip.

    MP


    čtvrtek 25. července 2013 8:36
    Moderátor
  • tak jsem na to přišel. v sub 4 to vrátilo 2 záznamy a to způsobilo pád. takže jsem to opravil a vše funguje v pořádku.

    VALL2

    • Označen jako odpověď VALL2 čtvrtek 5. září 2013 9:42
    čtvrtek 5. září 2013 9:42