Bonjour,
Voila mon code vba:
Private Sub CommandButtonOK_Click()
Application.ScreenUpdating = False
'Effacer texte + présentation dans la feuille données
Sheets("Données").Select
Cells.ClearContents
Cells.NumberFormat = "General"
Cells.Interior.ColorIndex = xlNone
Cells.Borders.LineStyle = xlNone
Call FusionCells(Range("A1:IV65536"), xlGeneral, xlBottom, False, False)
'Effacer texte + présentation dans la feuille données
Sheets("Etat des décisions").Select
Cells.ClearContents
Cells.NumberFormat = "General"
Cells.Interior.ColorIndex = xlNone
Cells.Borders.LineStyle = xlNone
Call FusionCells(Range("A1:IV65536"), xlGeneral, xlBottom, False, False)
'Effacer texte + présentation dans la feuille données
Sheets("Comptabilisation automatique").Select
Cells.ClearContents
Cells.NumberFormat = "General"
Cells.Interior.ColorIndex = xlNone
Cells.Borders.LineStyle = xlNone
Call FusionCells(Range("A1:IV65536"), xlGeneral, xlBottom, False, False)
'on teste les 2 zones de texte pour savoir si elles sont renseignées
'et si oui on fait le traitement
If Not (TextBoxDate1 = "" Or TextBoxDate2 = "") Then
Dim db As DAO.Database 'une base de données
Dim rq As DAO.QueryDef 'une requête
Dim rs As DAO.Recordset 'un jeu d'enregistrements (recordset)
Dim c As Field 'un champ
Dim i As Integer 'un compteur
'connexion à la bdd et à la requête
Set db = DBEngine.OpenDatabase("O:\ENGAGE\ENGAGE.mdb")
Set rq = db.QueryDefs("11)état décision en rentrant parametre")
'spécification des valeurs des paramètres
rq.Parameters(0).Value = TextBoxDate1
rq.Parameters(1).Value = TextBoxDate2
'accès aux données de la requête
Set rs = rq.OpenRecordset
'on se positionne à la cellule de départ
Sheets("Données").Select
Range("A7").Select
'Boucle sur tous les enregistrements du jeu
Do While Not rs.EOF
'initialisation du compteur
i = 0
'Boucle sur tous les champs
For Each c In rs.fields
ActiveCell.Offset(0, i).Value = rs.fields(c.Name)
i = i + 1
Next
ActiveCell.Offset(1).Select
rs.MoveNext
Loop
Call titre
Call soustitre
Call AfficherData
Call miseenpage
Call Compta
Call miseenpagecompta
'fermeture de l'userform + réinitialisation
'si laisse code ci dessous la date n'apparaitra pas automatiquement lors de la sauvegarde
'TextBoxDate1 = ""
'TextBoxDate2 = ""
UserForm1.Hide
'les 2 zones de texte ne sont pas renseignées, on affiche un message
Else
MsgBox "Saisie incomplète !", vbExclamation
End If
Sheets("Etat des décisions").Select
Range("A2").Select
Application.ScreenUpdating = False
End Sub
Je souhaiterai que lorsque je clique sur le bouton OK qu'il est quelquechose pour montrer que le programme est lancé, car le chargement dure environ 1minute mais rien n'indique que l'ordinateur travaille, si vous pouviez me proposer un code vba qui puisse répondre à ma demande.
Tous les propositions sont le bien venue.
Merci d'avance
Voila mon code vba:
Private Sub CommandButtonOK_Click()
Application.ScreenUpdating = False
'Effacer texte + présentation dans la feuille données
Sheets("Données").Select
Cells.ClearContents
Cells.NumberFormat = "General"
Cells.Interior.ColorIndex = xlNone
Cells.Borders.LineStyle = xlNone
Call FusionCells(Range("A1:IV65536"), xlGeneral, xlBottom, False, False)
'Effacer texte + présentation dans la feuille données
Sheets("Etat des décisions").Select
Cells.ClearContents
Cells.NumberFormat = "General"
Cells.Interior.ColorIndex = xlNone
Cells.Borders.LineStyle = xlNone
Call FusionCells(Range("A1:IV65536"), xlGeneral, xlBottom, False, False)
'Effacer texte + présentation dans la feuille données
Sheets("Comptabilisation automatique").Select
Cells.ClearContents
Cells.NumberFormat = "General"
Cells.Interior.ColorIndex = xlNone
Cells.Borders.LineStyle = xlNone
Call FusionCells(Range("A1:IV65536"), xlGeneral, xlBottom, False, False)
'on teste les 2 zones de texte pour savoir si elles sont renseignées
'et si oui on fait le traitement
If Not (TextBoxDate1 = "" Or TextBoxDate2 = "") Then
Dim db As DAO.Database 'une base de données
Dim rq As DAO.QueryDef 'une requête
Dim rs As DAO.Recordset 'un jeu d'enregistrements (recordset)
Dim c As Field 'un champ
Dim i As Integer 'un compteur
'connexion à la bdd et à la requête
Set db = DBEngine.OpenDatabase("O:\ENGAGE\ENGAGE.mdb")
Set rq = db.QueryDefs("11)état décision en rentrant parametre")
'spécification des valeurs des paramètres
rq.Parameters(0).Value = TextBoxDate1
rq.Parameters(1).Value = TextBoxDate2
'accès aux données de la requête
Set rs = rq.OpenRecordset
'on se positionne à la cellule de départ
Sheets("Données").Select
Range("A7").Select
'Boucle sur tous les enregistrements du jeu
Do While Not rs.EOF
'initialisation du compteur
i = 0
'Boucle sur tous les champs
For Each c In rs.fields
ActiveCell.Offset(0, i).Value = rs.fields(c.Name)
i = i + 1
Next
ActiveCell.Offset(1).Select
rs.MoveNext
Loop
Call titre
Call soustitre
Call AfficherData
Call miseenpage
Call Compta
Call miseenpagecompta
'fermeture de l'userform + réinitialisation
'si laisse code ci dessous la date n'apparaitra pas automatiquement lors de la sauvegarde
'TextBoxDate1 = ""
'TextBoxDate2 = ""
UserForm1.Hide
'les 2 zones de texte ne sont pas renseignées, on affiche un message
Else
MsgBox "Saisie incomplète !", vbExclamation
End If
Sheets("Etat des décisions").Select
Range("A2").Select
Application.ScreenUpdating = False
End Sub
Je souhaiterai que lorsque je clique sur le bouton OK qu'il est quelquechose pour montrer que le programme est lancé, car le chargement dure environ 1minute mais rien n'indique que l'ordinateur travaille, si vous pouviez me proposer un code vba qui puisse répondre à ma demande.
Tous les propositions sont le bien venue.
Merci d'avance