allard1977
Gebruiker
- Lid geworden
- 7 feb 2011
- Berichten
- 215
Code:
hallo allemaal,
Kan iemand mij helpen met het volgende probleem,
Ik heb 6 button's met ieder een andere vba code er onder. Nu moeten ze stap voor stap ingedrukt worden voor het proces maar ik zou het graag onder een button zetten. Maar lukt mij niet goed,
groet allard.
dit is de code:
[CODE]Private Sub stap1show_Click()
On Error GoTo Err_btn_MTDeelnemers_Click
DoCmd.SetWarnings False
Dim stDocName As String
stDocName = "MT_002_MaakTabelOmHondenrsToeTeKennen"
DoCmd.OpenQuery stDocName, acNormal, acEdit
stDocName = "MT_002_MaakTabelOmHondenrsToeTeKennen_APP2"
DoCmd.OpenQuery stDocName, acNormal, acEdit
stDocName = "MT_002_MaakTabelOmHondenrsToeTeKennen_APP3"
DoCmd.OpenQuery stDocName, acNormal, acEdit
DoCmd.SetWarnings True
MsgBox "Tabel is klaar !!!"
Exit_btn_MTDeelnemers_Click:
Exit Sub
Err_btn_MTDeelnemers_Click:
MsgBox Err.Description
Resume Exit_btn_MTDeelnemers_Click
End Sub
Private Sub stap2show_Click()
On Error GoTo Err_btn_NummersToekennen_Click
Dim oRst As DAO.Recordset
Dim oDb As DAO.Database
Dim L As Integer
Set oDb = CurrentDb
Set oRst = oDb.OpenRecordset("T007_HondenummerstekennenMT", dbOpenTable)
While Not oRst.EOF
L = L + 1
oRst.Edit
'If l < 10 Then
oRst.Fields("hondnr").Value = L
'End If
oRst.Update
oRst.MoveNext
Wend
oRst.Close
oDb.Close
Set oRst = Nothing
Set oDb = Nothing
MsgBox "Tabel is klaar !!!"
Exit_btn_NummersToekennen_Click:
Exit Sub
Err_btn_NummersToekennen_Click:
MsgBox Err.Description
Resume Exit_btn_NummersToekennen_Click
End Sub
Private Sub stap3show_Click()
On Error GoTo Err_btn__TblHondenUpdaten_Click
DoCmd.SetWarnings False
Dim stDocName As String
stDocName = "UPD_002_HondnummersUpdatenInTBLHonden"
DoCmd.OpenQuery stDocName, acNormal, acEdit
DoCmd.SetWarnings True
MsgBox "Update is afgewerkt !!!"
Exit_btn__TblHondenUpdaten_Click:
Exit Sub
Err_btn__TblHondenUpdaten_Click:
MsgBox Err.Description
Resume Exit_btn__TblHondenUpdaten_Click
End Sub
Private Sub stap4show_Click()
On Error GoTo Err_btn_maaktblvoorbereidlinenrs_Click
DoCmd.SetWarnings False
Dim stDocName As String
stDocName = "MT_003_MaakTabelOmHorizTeZetten"
DoCmd.OpenQuery stDocName, acNormal, acEdit
DoCmd.SetWarnings True
MsgBox "Tabel is klaar !!!"
Exit_btn_maaktblvoorbereidlinenrs_Click:
Exit Sub
Err_btn_maaktblvoorbereidlinenrs_Click:
MsgBox Err.Description
Resume Exit_btn_maaktblvoorbereidlinenrs_Click
End Sub
Private Sub stap5show_Click()
On Error GoTo Err_btn_linennrsgevenintbl_Click
Dim oRst As DAO.Recordset
Dim oDb As DAO.Database
Dim L As Integer
Dim previous_val As String
L = 0
previous_val = ""
Set oDb = CurrentDb
Set oRst = oDb.OpenRecordset("T008_NummerHorizTeZettenMT", dbOpenTable)
While Not oRst.EOF
L = L + 1
oRst.Edit
If oRst.Fields("persoonsnr").Value = previous_val Then
oRst.Fields("line_nr").Value = L
Else
L = 1
oRst.Fields("line_nr").Value = L
End If
previous_val = oRst.Fields("persoonsnr").Value
oRst.Update
oRst.MoveNext
Wend
oRst.Close
oDb.Close
Set oRst = Nothing
Set oDb = Nothing
MsgBox "Tabel is klaar !!!"
Exit_btn_linennrsgevenintbl_Click:
Exit Sub
Err_btn_linennrsgevenintbl_Click:
MsgBox Err.Description
Resume Exit_btn_linennrsgevenintbl_Click
End Sub
Private Sub stap6show_Click()
On Error GoTo Err_btn_horizontaalinquery_Click
DoCmd.SetWarnings False
Dim stDocName As String
stDocName = "Cross_001_HondnummersHorizontaalzetten"
DoCmd.OpenQuery stDocName, acNormal, acEdit
DoCmd.SetWarnings True
Exit_btn_horizontaalinquery_Click:
Exit Sub
Err_btn_horizontaalinquery_Click:
MsgBox Err.Description
Resume Exit_btn_horizontaalinquery_Click
End Sub
Private Sub stap7show_Click()
On Error GoTo Err_btn_NummersHorzontInTabel_Click
DoCmd.SetWarnings False
Dim stDocName As String
stDocName = "MT_004_TabelHondnummersHorizontaal"
DoCmd.OpenQuery stDocName, acNormal, acEdit
DoCmd.SetWarnings True
MsgBox "Tabel is klaar !!!"
Exit_btn_NummersHorzontInTabel_Click:
Exit Sub
Err_btn_NummersHorzontInTabel_Click:
MsgBox Err.Description
Resume Exit_btn_NummersHorzontInTabel_Click
End Sub
