Probleme de code

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)

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

Bonjour

Pas facile de comprendre sans avoir le fichier... mais je ne comprends pas le pourquoi de ces lignes

Sheets("Recap").Select.... jusque Sheets(NomSalle).Select

Pour moi vous pouvez les supprimer

D'autres choses que vous pouvez simplifier

- Supprimer les DIM

Dim lassociation As String
Dim lejour As String
Dim lheurede As String
Dim lheurea As String

- Supprimer :

lassociation = ComboBox1.Value
lejour = ComboBox3.Value
lheurede = ComboBox4.Value
lheurea = ComboBox5.Value

- Modifier cette partie de code

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 = ComboBox1.Value ' lassociation
    .Range("C" & L).Value = ComboBox3.Value 'lejour
    .Range("D" & L).Value = ComboBox4.Value 'lheurede
    .Range("E" & L).Value = ComboBox5.Value 'lheurea
End With

Cordialement

Bonjour,

Je commencerais par supprimer tous les Select.

Merci je vais regarder.Le fichier est en piece jointe

Si je fais ce qu'à dit Dan, je n'ai plus le récap sur la feuille NomSalle

Re

Si je fais ce qu'à dit Dan, je n'ai plus le récap sur la feuille NomSalle

Il faut évidemment remplacer les noms ci-dessous par la combobox correspondante

'lassociation = ComboBox1.Value

'lejour = ComboBox3.Value

'lheurede = ComboBox4.Value

'lheurea = ComboBox5.Value

• Supprimez ce que je vous ai suggéré dans mon post précédent
• Supprimez aussi cette partie :

Sheets("Recap").Select
.....
Sheets(NomSalle).Select

- Ensuite remplacez le code que je vous ai donné par celui-ci :

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 = ComboBox1.Value 'lassociation
    .Range("C" & L).Value = ComboBox3.Value 'lejour
    .Range("D" & L).Value = ComboBox4.Value 'lheurede
    .Range("E" & L).Value = ComboBox5.Value 'lheurea
    hde = .Cells(L, 4) 'ActiveCell.Value
    ha = .Cells(L, 5)
End With

- A cette ligne : remplacez

Select Case lejour

par -->

Select Case ComboBox3.Value

- A la fin de la macro : remplacez

ActiveCell.FormulaR1C1 = lassociation

par

ActiveCell.FormulaR1C1 = ComboBox1.Value

Dans la Sub TraitementAssoc(), remplacez aussi lassociation par combobox.value

Restera à éliminer tous les sélect mais dites avant si cela correspond à ce que vous voulez

Sinon c'est un joli fichier...

Merci pour ton aide

J'ai fait les modifs mais j'ai une erreur qui apparaît ici au niveau de Cells

vide = 0
lde = lignede
la = lignea
Select Case ComboBox3.Value
    Case "Lundi"
        For I = lde To la
            Cells(I, 3).Select

Re

Essayez avec ce fichier dans lequel j'ai désactivé certaines instructions pour simplifier (en vert)

Je pense que cela devrait fonctionner

Crdlt

Merci

Ca à l'air de fonctionner.

Je vais m'attacher aux autre fonction de mon fichier le planning gymnase et associations et suppression

Re

Ok. Vérifiez vos variables non déclarées

Vous pouvez supprimer celle ci -> Dim plageSel As Range. Elle ne sert pas

Par contre Lig, Lignede, lignea et vide devraient l'être.

Je pense que ceci devrait fonctionner

Dim Lig as byte, lignede as byte, lignea as byte

Dim vide as boolean

Pour être sûr, mettez cette instruction "Option Explicit" tout en haut du module juste avant Private userform activation

Si une variable n'est pas déclarée, excel vous le dira automatiquement

Cordialement

Je viens de faire des test, et j'ai un soucis.

Quand je crée de nouvelles feuilles, la liste dans l'onglet liste change de nom et mes installations disparaissent.

Bonjour

Quand je crée de nouvelles feuilles, la liste dans l'onglet liste change de nom et mes installations disparaissent.

Quelle liste change ?

Expliquez moi pas à pas que je reproduise le souci

De mon coté, en relisant votre code je pense qu'il y a un souci avec la colonne E au niveau des associations avec la macro traitementassoci.

Crdlt

Bonjour,

Quand je fais plusieurs réservations avec la création des feuille NomSalle. Dans la colonne installation de la feuille liste, les cases prennent le nom des onglet (menu, liste,....)

Je vais regarder le problème que tu soulève.

Re

Ok mais la liste des installations est déjà dans la colonne A. Je ne comprends pas le souci... et cela ne vient pas des modifications effectuées.

Je viens de créer 7 onglets de planning et aucun problème.

Par contre, j'aimerai caché les onglets listes et modèle et cela me pause un problème

C'est bon, j'ai résolu avec le code

Worksheets("Modele").Visible = True
    Worksheets("Modele").Copy after:=Worksheets("Recap") 'copie l'onglet Modèle après Recap
    ActiveSheet.Name = NomSalle 'renome l'onglet actif
    Worksheets("Modele").Visible = False

Mon fichier apparemment terminé

Re

En regardant le dernier fichier, je vois ce code --> TraitementAssoc

Si je lis bien il sert à vérifier que le nom de l'association existe dans la feuille liste ??

Je vois aussi une ligne "Ajoute:"

Cela correspond à quoi dans votre fichier ?

Pour honnête, je suis parti d'un fichier existant que j'ai modifié à ma façon et en fonction de ce que je voulais faire.

Je n'ai pas touché cette partie là. Je suppose que si le nom de l'association n'existe pas dans la feuille liste, il ajoute à la liste.

J'ai encore 1 ou 2 petit soucis, mais je vais chercher comment les résoudre.