Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Probleme de code


Sujet :

Macros et VBA Excel

  1. #1
    Candidat au Club
    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)
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    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

  2. #2
    Expert confirmé
    Re,

    Commences par supprimer tous les Select.
    Cordialement,
    Patrice
    Personne ne peut détenir tout le savoir, c'est pour ça qu'on le partage.

    Pour dire merci, cliquer sur et quand la discussion est finie, penser à cliquer sur