Création de base de donnée pour la gestion des salles et clients en VBA
a
Bonsoir à tous,
Je veux créer une base de gestion des salles et clients. cette base permettra de gérer les entrées et sorties des clients et la gestion des salles.
dans la base j'ai trois formulaire à savoir:
- le formulaire de saisie des entrées de client et occupation des salles contenant les codes suivant
pour ajouter le client dans les différent tableau du fichier
Private Sub BtnAjoutEntree_Click()
Dim I As Integer
Sheets("LISTE_OCCU_SALLE").Activate
For I = 2 To Range("A:A").End(xlDown).Row
If Cells(I, 1).Text = CboSalle.Text Then
MsgBox "Cette salle est déjà occupé par " & Cells(I, 3).Text: CboSalle = "": CboSalle.SetFocus: Exit Sub
End If
Next I
TxtNomClient.SetFocus
[A65536].End(xlUp).Offset(1, 0).Select
Cells(ActiveCell.Row, 1) = CboSalle.Text
Cells(ActiveCell.Row, 2) = TxtIntituleSalle.Text
Cells(ActiveCell.Row, 3) = TxtNomClient.Text
Cells(ActiveCell.Row, 4) = TxtAdresseClient.Text
Cells(ActiveCell.Row, 5) = TxtTelClient.Text
Cells(ActiveCell.Row, 6) = TxtPU.Text
Cells(ActiveCell.Row, 7) = Date
Sheets("liste_transaction").Activate
TxtNomClient.SetFocus
[A65536].End(xlUp).Offset(1, 0).Select
Cells(ActiveCell.Row, 1) = TxtNomClient.Text
Cells(ActiveCell.Row, 2) = TxtAdresseClient.Text
Cells(ActiveCell.Row, 3) = TxtTelClient.Text
Cells(ActiveCell.Row, 4) = CboSalle.Text
Cells(ActiveCell.Row, 5) = TxtIntituleSalle.Text
Cells(ActiveCell.Row, 6) = TxtPU.Text
Cells(ActiveCell.Row, 7) = Date
Sheets("config").Activate
For I = 2 To Range("A:A").End(xlDown).Row
If CboSalle.Text = Cells(I, 1).Text Then
Cells(I, 1).Select
Selection.Offset(0, 3) = "1"
End If
Next I
TxtNomClient = ""
TxtAdresseClient = ""
TxtTelClient = ""
CboSalle = ""
TxtIntituleSalle = ""
End Sub
Private Sub BtnEffacerAjoutForm_Click()
TxtNomClient = ""
TxtAdresseClient = ""
TxtTelClient = ""
CboSalle = ""
TxtIntituleSalle = ""
End Sub
Private Sub BtnFermeAjoutNouvClient_Click()
Unload AjoutNouvClient
End Sub
Private Sub CboSalle_Change()
Dim I As Integer
If CboSalle = "" Then
Label5.Visible = False
Label6.Visible = False
TxtPU.Visible = False
TxtIntituleSalle.Visible = False
BtnAjoutEntree.Enabled = False
Else
Label5.Visible = True
Label6.Visible = True
TxtIntituleSalle.Visible = True
TxtPU.Visible = True
Sheets("CONFIG").Activate
For I = 2 To Range("A:A").End(xlDown).Row
If CboSalle.Text = Cells(I, 1) Then
TxtIntituleSalle = Cells(I, 2).Text
TxtPU = Cells(I, 3).Text
End If
Next I
BtnAjoutEntree.Enabled = True
End If
End Sub
Private Sub TxtNomClient_Change()
If TxtNomClient = "" Then
BtnEffacerAjoutForm.Enabled = False
Label4.Visible = False
Label6.Visible = False
CboSalle.Visible = False
TxtPU.Visible = False
Else
BtnEffacerAjoutForm.Enabled = True
Label4.Visible = True
CboSalle.Visible = True
End If
End Sub
- le formulaire de saisie des sorties et libération des salles avec les codes suivants:
Private Sub BtnLibere_Click()
Sheets("CONFIG").Activate
For I = 2 To Range("A:A").End(xlDown).Row
If CboSalle.Text = Cells(I, 1).Text Then
Cells(I, 2) = "0"
End If
Next I
Sheets("LISTE_TRANSACTION").Activate
For I = 2 To Range("A:A").End(xlDown).Row
If CboSalle.Text = Cells(I, 4).Text And TxtNomClient = Cells(I, 1).Text Then
Cells(I, 7) = Date
End If
Next I
Sheets("LISTE_OCCU_SALLE").Activate
For I = 2 To Range("A:A").End(xlDown).Row
If CboSalle.Text = Cells(I, 1).Text Then
Cells(I, 1).Select
End If
Next I
End Sub
Private Sub CboSalle_Change()
Dim I As Integer
If CboSalle = "" Then
Label2.Visible = False
Label3.Visible = False
Label4.Visible = False
Label5.Visible = False
Label6.Visible = False
Label7.Visible = False
Label8.Visible = False
TxtAdresseClient.Visible = False
TxtDateEntre.Visible = False
TxtDateSortie.Visible = False
TxtIntituleSalle.Visible = False
TxtNomClient.Visible = False
TxtPU.Visible = False
TxtTelClient.Visible = False
BtnLibere.Visible = False
BtnEffacer.Visible = False
BtnFermer.Visible = False
Else
Label2.Visible = True
Label3.Visible = True
Label4.Visible = True
Label5.Visible = True
Label6.Visible = True
Label7.Visible = True
Label8.Visible = True
TxtAdresseClient.Visible = True
TxtDateEntre.Visible = True
TxtDateSortie.Visible = True
TxtIntituleSalle.Visible = True
TxtNomClient.Visible = True
TxtPU.Visible = True
TxtTelClient.Visible = True
BtnLibere.Visible = True
BtnEffacer.Visible = True
BtnFermer.Visible = True
Sheets("LISTE_OCCU_SALLE").Activate
For I = 2 To Range("A:A").End(xlDown).Row
If CboSalle.Text = Cells(I, 1).Text Then
TxtIntituleSalle = Cells(I, 2).Text
TxtNomClient = Cells(I, 3).Text
TxtAdresseClient = Cells(I, 4).Text
TxtTelClient = Cells(I, 5).Text
TxtPU = Cells(I, 6).Text
TxtDateEntre = Cells(I, 7).Text
TxtDateSortie = Date
End If
Next I
End If
End Sub
Private Sub UserForm_Initialize()
Label2.Visible = False
Label3.Visible = False
Label4.Visible = False
Label5.Visible = False
Label6.Visible = False
Label7.Visible = False
Label8.Visible = False
CboSalle.Visible = True
TxtAdresseClient.Visible = False
TxtDateEntre.Visible = False
TxtDateSortie.Visible = False
TxtIntituleSalle.Visible = False
TxtNomClient.Visible = False
TxtPU.Visible = False
TxtTelClient.Visible = False
BtnLibere.Visible = False
BtnEffacer.Visible = False
BtnFermer.Visible = False
End Sub
- le formulaire des point journalier avec le code
Private Sub BtnFermerVal_Click()
Unload ValideOccuSalle
End Sub
Private Sub BtnValideOccu_Click()
Dim I As Integer: I = 2
ThisWorkbook.Worksheets("POINT_JOURNALIER").Activate
Cells(1, 1).End(xlToRight).Offset(0, 1).Select
Selection.Value = Date
ThisWorkbook.Worksheets("config").Activate
Range("E2:E24").Copy
ThisWorkbook.Worksheets("POINT_JOURNALIER").Activate
Selection.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
BtnValideOccu.Visible = False
BtnAnnulerOccu.Visible = True
Sheets("config").Activate
End Sub
Private Sub BtnAnnulerOccu_Click()
ThisWorkbook.Worksheets("POINT_JOURNALIER").Cells(1, 1).End(xlToRight).EntireColumn.Delete
BtnAnnulerOccu.Visible = False
BtnValideOccu.Visible = True
Sheets("config").Activate
End Sub
Private Sub UserForm_Initialize()
TextBox1 = Date
If ThisWorkbook.Worksheets("POINT_JOURNALIER").Cells(1, 1).End(xlToRight).Text = TextBox1.Text Then
BtnValideOccu.Visible = False
BtnAnnulerOccu.Visible = True
Sheets("config").Activate
Else
BtnValideOccu.Visible = True
BtnAnnulerOccu.Visible = False
Sheets("config").Activate
End If
End Sub
Mais sans le formulaire de saisie des sorties, les autres fonctionnent normalement et quand j'insère son code l'excel se plante.
Merci pour votre attention.