Richard 58
XLDnaute Nouveau
Bonjour à tous,
Pouvez vous m'aider à trouver l'erreur dans mon code ?
Lorsque je clique sur valider, mes donner de mon userform ne s'affiche pas les uns en dessous des autres. Une données remplace l'autres dans le tableau (recap)
Merci à vous
Pouvez vous m'aider à trouver l'erreur dans mon code ?
Lorsque je clique sur valider, mes donner de mon userform ne s'affiche pas les uns en dessous des autres. Une données remplace l'autres dans le tableau (recap)
Code:
Private Sub CommandButton1_Click()
Dim OE As Worksheet 'déclare la variable OE (Onglet Existant)
Dim NomSalle As String
Dim hde As String
Dim ha As String
Dim valhde As String
Dim valha As String
Dim lassociation As String
Dim lejour As String
Dim lheurede As String
Dim lheurea As String
Dim lignede As Variant
Dim plageSel As Range
Dim col As Integer
Dim L As Integer
NomSalle = ComboBox2.Value
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set OE = Worksheets(NomSalle) 'définit l'onglet OE (génère une erreur si cet onglet n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été générée
Err.Clear 'supprime l'erreur
Worksheets("Modele").Copy after:=Worksheets("Modele") 'copie l'onglet Modèle après ljui-même
ActiveSheet.Name = NomSalle 'renome l'onglet actif
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
lassociation = ComboBox1.Value
lejour = ComboBox3.Value
lheurede = ComboBox4.Value
lheurea = ComboBox5.Value
Call TraitementAssoc
With Worksheets("Recap")
L = .Range("a65536").End(xlUp).Row + 1 'Pour placer le nouvel enregistrement à la première ligne de tableau non vide
.Range("A" & L).Value = NomSalle
.Range("B" & L).Value = lassociation
.Range("C" & L).Value = lejour
.Range("D" & L).Value = lheurede
.Range("E" & L).Value = lheurea
End With
Sheets("Recap").Select
Range("A1").End(xlDown).Offset(1, 0).Select
ligne = ActiveCell.Row
ActiveCell.Value = NomSalle
ligne = ActiveCell.Row
Cells(ligne, 2).Select
ActiveCell.Value = lassociation
Cells(ligne, 3).Select
ActiveCell.Value = lejour
Cells(ligne, 4).Select
ActiveCell.Value = lheurede
hde = ActiveCell.Value
Cells(ligne, 5).Select
ActiveCell.Value = lheurea
ha = ActiveCell.Value
Sheets(NomSalle).Select
Worksheets(NomSalle).Select
'Détermination de la ligne de et de la ligne à pour le planing
lig = 4
col = 1
Cells(lig, col).Select
Do While ActiveCell.Value <> ""
valhde = ActiveCell.Value
If valhde = hde Then
lignede = ActiveCell.Row
Exit Do
End If
lig = lig + 1
Cells(lig, col).Select
Loop
lig = 4
col = 2
Cells(lig, col).Select
Do While ActiveCell.Value <> ""
valha = ActiveCell.Value
If valha = ha Then
lignea = ActiveCell.Row
Exit Do
End If
lig = lig + 1
Cells(lig, col).Select
Loop
'Recherche dans planing si la plage a affecter est deja prise
vide = 0
lde = lignede
la = lignea
Select Case lejour
Case "Lundi"
For I = lde To la
Cells(I, 3).Select
If ActiveCell.Value <> "" Then
vide = 1
Exit For
End If
Next
Range(Cells(lignede, 3), Cells(lignea, 3)).Select
Case "Mardi"
For I = lde To la
Cells(I, 4).Select
If ActiveCell.Value <> "" Then
vide = 1
Exit For
End If
Next
Range(Cells(lignede, 4), Cells(lignea, 4)).Select
Case "Mercredi"
For I = lde To la
Cells(I, 5).Select
If ActiveCell.Value <> "" Then
vide = 1
Exit For
End If
Next
Range(Cells(lignede, 5), Cells(lignea, 5)).Select
Case "Jeudi"
For I = lde To la
Cells(I, 6).Select
If ActiveCell.Value <> "" Then
vide = 1
Exit For
End If
Next
Range(Cells(lignede, 6), Cells(lignea, 6)).Select
Case "Vendredi"
For I = lde To la
Cells(I, 7).Select
If ActiveCell.Value <> "" Then
vide = 1
Exit For
End If
Next
Range(Cells(lignede, 7), Cells(lignea, 7)).Select
Case "Samedi"
For I = lde To la
Cells(I, 8).Select
If ActiveCell.Value <> "" Then
vide = 1
Exit For
End If
Next
Range(Cells(lignede, 8), Cells(lignea, 8)).Select
Case "Dimanche"
For I = lde To la
Cells(I, 9).Select
If ActiveCell.Value <> "" Then
vide = 1
Exit For
End If
Next
Range(Cells(lignede, 9), Cells(lignea, 9)).Select
End Select
If vide = 1 Then
MsgBox "Plage déjà occupée partiellement ou en totalité!!!"
Worksheets("Recap").Select
Range("A1").End(xlDown).Offset(0, 0).Select
Selection.EntireRow.Delete
Worksheets(NomSalle).Select
Exit Sub
End If
'Affectation de la plage mise en gras ecriture bleue et fusion des cellules
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.ShrinkToFit = False
.MergeCells = True
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 5
End With
ActiveCell.FormulaR1C1 = lassociation
End Sub
Merci à vous