KouzinePhilo
XLDnaute Nouveau
Bonjour
j'ai développé un fichier VBA EXCEL sur pc avec un UserForm classique
L'userform permet de créer des demandes de réservations (base de données)
Lorsque je crée une "nouvelle demande" ça plante sur MAC mais ça enregistre bien les données comme il faut donc j'ai mis des ON ERROR NEXT là où ça semblait poser problème.
Depuis c'est parfait je peux créer mes contacts tout marche bien sauf qu'au moment de fermer le userform le MAC plante et tout se ferme !!
J'ai peut être pas pigé un truc sur le ON ERROR RESUME NEXT
est-ce qu'il faut ajouter une commande de fin d'instruction après l'avoir utilisé... ? Si mon plantage a été simplement "décalé" comment faire ??
Voici mon code en entier.
j'ai développé un fichier VBA EXCEL sur pc avec un UserForm classique
L'userform permet de créer des demandes de réservations (base de données)
Lorsque je crée une "nouvelle demande" ça plante sur MAC mais ça enregistre bien les données comme il faut donc j'ai mis des ON ERROR NEXT là où ça semblait poser problème.
Depuis c'est parfait je peux créer mes contacts tout marche bien sauf qu'au moment de fermer le userform le MAC plante et tout se ferme !!
J'ai peut être pas pigé un truc sur le ON ERROR RESUME NEXT
est-ce qu'il faut ajouter une commande de fin d'instruction après l'avoir utilisé... ? Si mon plantage a été simplement "décalé" comment faire ??
Voici mon code en entier.
Code:
Option Explicit
'////////////////////////////////////////
'FORMULAIRE CREATION DEMANDE NEWDEMANDE
'////////////////////////////////////////
Public Sub TRIERlaLISTE()
Application.ScreenUpdating = False
Worksheets("LISTING_ASSOS").Range("A2:DS1000").Sort Key1:=Worksheets("LISTING_ASSOS").Range("B2:B1000")
Application.ScreenUpdating = True
End Sub
'*****************************************
'INITIALISATION
'*****************************************
Sub UserForm_Initialize()
'A l'ouverture du UseForm on tri et on definit les valeurs qui seront dans les listes deroulantes
TRIERlaLISTE
Me.ComboBoxCHERCHER.List = Range("NomsAssos").Value
Me.ComboBoxNbre.List = Range("Nbrecreneaux").Value
TRIERlaLISTE
End Sub
'***********************************************************************
'CHERCHER DANS LA LISTE L ASSO QUI FAIT LA DEMANDE ET AFFICHER L'ID
'************************************************************************
Private Sub comboboxCHERCHER_Change()
Dim LigneID As Integer
LigneID = Me.ComboBoxCHERCHER.ListIndex
Me.TxtID = Sheets("LISTING_ASSOS").Cells(LigneID + 2, 1)
End Sub
'*****************************************
'BLOQUER LES COMMANDES SUPPR ET ENREGISTRER
'*****************************************
Sub FinDeDemande()
Unload NewDemande
Unload FORMDemandes
FORMDemandes.Show
TRIERlaLISTE
End Sub
'*****************************************
'Nouvelle DEMANDE : champs sur fiche ASSOS
'*****************************************
Sub CreaListingAsso()
'On enregistre dans la fiche asso les champs de la Nouvelle demande
Dim LigneASSO As Integer
LigneASSO = Me.ComboBoxCHERCHER.ListIndex
Sheets("LISTING_ASSOS").Cells(LigneASSO + 2, 86) = "VRAI"
Sheets("LISTING_ASSOS").Cells(LigneASSO + 2, 87) = Me.TxtDateDemande.Text
Sheets("LISTING_ASSOS").Cells(LigneASSO + 2, 88) = Me.ComboBoxNbre.Value
Sheets("LISTING_ASSOS").Cells(LigneASSO + 2, 89) = Me.TxtActivite1.Text
Sheets("LISTING_ASSOS").Cells(LigneASSO + 2, 90) = Me.TxtActivite2.Text
Sheets("LISTING_ASSOS").Cells(LigneASSO + 2, 91) = Me.TxtActivite3.Text
End Sub
'*****************************************
'CRENEAU 1 : Enregistrer sur LISTING_DEMANDES
'*****************************************
Sub Creneau1Save()
On Error Resume Next
'SUR L ONGLET DES DEMANDES
'On cree une premire ligne pour le creneau 1
With Sheets("LISTING_DEMANDES")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Value = Me.TxtID.Text
.Cells(.Rows.Count, 2).End(xlUp).Offset(1).Value = Me.ComboBoxCHERCHER.Value & "_Creneau No1"
.Cells(.Rows.Count, 3).End(xlUp).Offset(1).Value = Me.TxtDateDemande.Text
.Cells(.Rows.Count, 4).End(xlUp).Offset(1).Value = Me.ComboBoxNbre.Value
.Cells(.Rows.Count, 6).End(xlUp).Offset(1).Value = Me.TxtActivite1.Text
.Cells(.Rows.Count, 24).End(xlUp).Offset(1).Value = "Creneau No1"
End With
End Sub
'*****************************************
'CRENEAU 2 : Enregistrer sur LISTING_DEMANDES
'*****************************************
Sub Creneau2Save()
On Error Resume Next
With Sheets("LISTING_DEMANDES")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Value = Me.TxtID.Text
.Cells(.Rows.Count, 2).End(xlUp).Offset(1).Value = Me.ComboBoxCHERCHER.Value & "_Creneau No2"
.Cells(.Rows.Count, 3).End(xlUp).Offset(1).Value = Me.TxtDateDemande.Text
.Cells(.Rows.Count, 4).End(xlUp).Offset(1).Value = Me.ComboBoxNbre.Value
.Cells(.Rows.Count, 6).End(xlUp).Offset(1).Value = Me.TxtActivite2.Text
.Cells(.Rows.Count, 24).End(xlUp).Offset(1).Value = "Creneau No2"
End With
End Sub
'*****************************************
'CRENEAU 3 : Enregistrer sur LISTING_DEMANDES
'*****************************************
Sub Creneau3Save()
On Error Resume Next
With Sheets("LISTING_DEMANDES")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1).Value = Me.TxtID.Text
.Cells(.Rows.Count, 2).End(xlUp).Offset(1).Value = Me.ComboBoxCHERCHER.Value & "_Creneau No3"
.Cells(.Rows.Count, 3).End(xlUp).Offset(1).Value = Me.TxtDateDemande.Text
.Cells(.Rows.Count, 4).End(xlUp).Offset(1).Value = Me.ComboBoxNbre.Value
.Cells(.Rows.Count, 6).End(xlUp).Offset(1).Value = Me.TxtActivite3.Text
.Cells(.Rows.Count, 24).End(xlUp).Offset(1).Value = "Creneau No3"
End With
End Sub
'*****************************************
'CLIC SUR ENREGISTRER LA NEW DEMANDE
'*****************************************
Private Sub CommandButtonCreerDemande_Click()
'on enregistre que si tous les champs sont remplis
On Error Resume Next
If Me.ComboBoxNbre.Value = "" Then MsgBox ("Veuillez remplir tous les champs")
'SI 1 SEUL CRENEAU DEMANDE
'*****************************************
If (Me.ComboBoxNbre.Value = 1) Then
If Me.ComboBoxCHERCHER.Value = "" Or Me.TxtDateDemande.Text = "" Or Me.TxtActivite1.Text = "" Then
MsgBox ("Veuillez remplir tous les champs")
Else
'SUR L ONGLET DES FICHES ASSOS
'On remplit les champs des demandes
CreaListingAsso
Creneau1Save
FinDeDemande
End If
End If
'SI 2 CRENEAUX DEMANDES
'*****************************************
If (Me.ComboBoxNbre.Value = 2) Then
If Me.ComboBoxCHERCHER.Value = "" Or Me.TxtDateDemande.Text = "" Or Me.TxtActivite1.Text = "" Or Me.TxtActivite2.Text = "" Then
MsgBox ("Veuillez remplir tous les champs")
Else
'SUR L ONGLET DES FICHES ASSOS
'On remplit les champs des demandes
CreaListingAsso
Creneau1Save
Creneau2Save
FinDeDemande
End If
End If
'SI 3 CRENEAUX DEMANDES
'*****************************************
If (Me.ComboBoxNbre.Value = 3) Then
If Me.ComboBoxCHERCHER.Value = "" Or Me.TxtDateDemande.Text = "" Or Me.TxtActivite1.Text = "" Or Me.TxtActivite2.Text = "" Or Me.TxtActivite3.Text = "" Then
MsgBox ("Veuillez remplir tous les champs")
Else
'SUR L ONGLET DES FICHES ASSOS
'On remplit les champs des demandes
CreaListingAsso
Creneau1Save
Creneau2Save
Creneau3Save
FinDeDemande
End If
End If
End Sub
'*****************************************
'CLIC SUR ANNULER
'*****************************************
Private Sub CommandButtonAnnulerDemande_Click()
Unload NewDemande
End Sub