IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
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 :

Fichier de réservation [XL-2019]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre du Club
    Homme Profil pro
    Agent administratif territorial
    Inscrit en
    Avril 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Nièvre (Bourgogne)

    Informations professionnelles :
    Activité : Agent administratif territorial
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : Avril 2020
    Messages : 8
    Par défaut Fichier de réservation
    Bonjour à tous,

    J'essaie de faire une petite application de réservation d'installation à la semaine voir à l'année mais des erreurs se glissent dans ma programmation. J'ai besoin de votre aide.

    Je m’inspire d'une appli que j'ai téléchargé. (fichier de départ)

    Je met en pièce jointe mon fichier de base avec lequel j'essaie de faire le mien.

    Pouvez m'aider à faire fonctionner mon fichier intitulé essai réservation ?

    Ah, j'oubliais, je suis débutant en code VBA et c'est ma première création de fichier. J'ai déjà créer des formulaire mais beaucoup plus simple

    Merci
    Fichiers attachés Fichiers attachés

  2. #2
    Expert éminent Avatar de Menhir
    Homme Profil pro
    Ingénieur
    Inscrit en
    Juin 2007
    Messages
    16 037
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : Ingénieur
    Secteur : Industrie

    Informations forums :
    Inscription : Juin 2007
    Messages : 16 037
    Par défaut
    Citation Envoyé par Richard58 Voir le message
    des erreurs se glissent dans ma programmation.
    Serait-il possible d'en savoir un peu plus sur ces "erreurs" ?

    Je met en pièce jointe mon fichier de base avec lequel j'essaie de faire le mien.
    Beaucoup de participants actifs de ce forum n'ouvre pas les fichiers joints.
    A lire : https://www.developpez.net/forums/d8...s-discussions/

  3. #3
    Membre du Club
    Homme Profil pro
    Agent administratif territorial
    Inscrit en
    Avril 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Nièvre (Bourgogne)

    Informations professionnelles :
    Activité : Agent administratif territorial
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : Avril 2020
    Messages : 8
    Par défaut
    La première erreur arrive quand je veux créer une nouvelle feuille, je n'arrive pas à la nommer avec le nom que je souhaite.
    On appelle une installation sportive dans une listes, la page doit s'ouvrir avec le nom de l'installation.

  4. #4
    Membre Expert
    Femme Profil pro
    Ingénieur
    Inscrit en
    Octobre 2016
    Messages
    1 703
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Âge : 30
    Localisation : France, Indre et Loire (Centre)

    Informations professionnelles :
    Activité : Ingénieur
    Secteur : Industrie

    Informations forums :
    Inscription : Octobre 2016
    Messages : 1 703
    Par défaut
    Bonjour,

    quand je veux créer une nouvelle feuille, je n'arrive pas à la nommer avec le nom que je souhaite.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Sub nouvelleFeuille()
        ThisWorkbook.Sheets.Add
        ActiveSheet.Name = "nouveau nom"
    End Sub
    Pour le reste, je n'ouvre pas les pièces jointes pour des raisons de sécurité (https://www.developpez.net/forums/d8...s-discussions/)
    Il faudrait que tu nous donnes le code sur lequel tu as des problèmes (utilise les balises code => bouton # dans le menu).
    Dis-nous si tu as un erreur. Si oui, laquelle et où.
    Si tu n'as pas d'erreur, qu'est-ce qui ne fonctionne pas comme tu le voudrais ?
    N'hésites pas à joindre des copies d'écran de ton classeur pour nous aider à comprendre la structure de ton classeur si cela peut aider.

  5. #5
    Expert confirmé Avatar de Patrice740
    Homme Profil pro
    Retraité
    Inscrit en
    Mars 2007
    Messages
    2 475
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Mars 2007
    Messages : 2 475
    Par défaut
    Bonjour le Fil

    Il est plus propre d'écrire :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    Sub nouvelleFeuille()
    Dim wsh As Worksheet
      Set wsh = ThisWorkbook.Worksheets.Add
      wsh.Name = "nouveau nom"
    End Sub
    ou
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    Sub nouvelleFeuille()
      ThisWorkbook.Worksheets.Add.Name = "nouveau nom"
    End Sub

  6. #6
    Membre du Club
    Homme Profil pro
    Agent administratif territorial
    Inscrit en
    Avril 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Nièvre (Bourgogne)

    Informations professionnelles :
    Activité : Agent administratif territorial
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : Avril 2020
    Messages : 8
    Par défaut
    Hello,
    Et merci de s’intéresser à mon cas

    Voici le code
    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
    Private Sub ComboBox2_AfterUpdate()
       Sheets("Modele").Select
        Sheets("Modele").Copy after:=Sheets("Modele")
        Sheets("Modele (2)").Select
        Sheets("Modele (2)").Name = NomSalle
        Sheets("listes").Select
        Range("A1").Select
        If ActiveCell.Value = "" Then
            ActiveCell.Value = NomSalle
            Sheets("liste").Select
            Exit Sub
        End If
        If ActiveCell.Offset(1, 0).Value = "" Then
            ActiveCell.Offset(1, 0).Value = NomSalle
        Else
            Selection.End(xlDown).Select
            ActiveCell.Offset(1, 0).Value = NomSalle
        End If
    End Sub

  7. #7
    Membre Expert
    Femme Profil pro
    Ingénieur
    Inscrit en
    Octobre 2016
    Messages
    1 703
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Âge : 30
    Localisation : France, Indre et Loire (Centre)

    Informations professionnelles :
    Activité : Ingénieur
    Secteur : Industrie

    Informations forums :
    Inscription : Octobre 2016
    Messages : 1 703
    Par défaut
    Re-bonjour,

    1ère chose : évite d'utiliser Select/ Activate etc ... Cela peut entraîner rapidement des problèmes et ne sert à rien. L'enregistreur de macro en met partout, mais il faut nettoyer le code après. Donc chez toi, ça ferait ceci :
    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
    Private Sub ComboBox2_AfterUpdate()
        Sheets("Modele").Copy after:=Sheets("Modele")
        Sheets("Modele (2)").Name = NomSalle
     
        If Sheets("listes").Range("A1").Value = "" Then
            Sheets("listes").Range("A1").Value = NomSalle
            Exit Sub
        End If
     
        If Sheets("listes").Range("A1").Offset(1, 0).Value = "" Then
            Sheets("listes").Range("A1").Offset(1, 0).Value = NomSalle
        Else
            Sheets("listes").Range("A1").End(xlDown).Offset(1, 0).Value = NomSalle
        End If
    End Sub
    2ème chose : tu utilises une variable qui n'a pas de valeur. Que vaut NomSalle ? Tu ne le dis jamais dans ton code ? Est-ce que c'est la valeur de ComboBox2 ? Dans ce cas, il faut le dire :
    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
    Private Sub ComboBox2_AfterUpdate()
        Dim NomSalle As String
        NomSalle = ComboBox2     
     
        Sheets("Modele").Copy after:=Sheets("Modele")
        Sheets("Modele (2)").Name = NomSalle
     
        If Sheets("listes").Range("A1").Value = "" Then
            Sheets("listes").Range("A1").Value = NomSalle
            Exit Sub
        End If
     
        If Sheets("listes").Range("A1").Offset(1, 0).Value = "" Then
            Sheets("listes").Range("A1").Offset(1, 0).Value = NomSalle
        Else
            Sheets("listes").Range("A1").End(xlDown).Offset(1, 0).Value = NomSalle
        End If
    End Sub
    => tout sur les Combobox

  8. #8
    Membre du Club
    Homme Profil pro
    Agent administratif territorial
    Inscrit en
    Avril 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Nièvre (Bourgogne)

    Informations professionnelles :
    Activité : Agent administratif territorial
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : Avril 2020
    Messages : 8
    Par défaut
    Merci Riaolle, cela fonctionne parfaitement
    Par contre, quand je valide il ne se passe rien, donc si tu peux m'aider encore

    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
    '--------------------------------------------------------------------------------
    Private Sub Valider_Click()
    Dim hde As String
    Dim ha As String
    Dim valhde As String
    Dim valha As String
     
    'Reservation.Hide
    'Application.ScreenUpdating = False
    lafeuille = gymnase.Value
    lassociation = association.Value
    lejour = jour.Value
    lheurede = "'" & heurede.Value
    lheurea = "'" & heurea.Value
     
    Call TraitementAssoc
     
    Sheets("Recap").Select
    Range("A1").End(xlDown).Offset(1, 0).Select
    ligne = ActiveCell.Row
    ActiveCell.Value = lafeuille
    ligne = ActiveCell.Row
    Cells(ligne, 2).Select
    ActiveCell.Value = lassociation
     
     
    Sheets("Recap").Select
    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(lafeuille).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é!!!"
        Sheets("Récap").Select
        Range("A1").End(xlDown).Offset(0, 0).Select
        Selection.EntireRow.Delete
        Sheets(lafeuille).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

  9. #9
    Membre Expert
    Femme Profil pro
    Ingénieur
    Inscrit en
    Octobre 2016
    Messages
    1 703
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Âge : 30
    Localisation : France, Indre et Loire (Centre)

    Informations professionnelles :
    Activité : Ingénieur
    Secteur : Industrie

    Informations forums :
    Inscription : Octobre 2016
    Messages : 1 703
    Par défaut
    Cela fonctionne parfaitement, mais rien ne se passe ? ... Alors ça ne fonctionne pas parfaitement

    1. Attention aux Select et Activate !!! Débarasse-toi de ceux-ci, car ils peuvent vite entraîner des problèmes. En plus, ça va simplifier ton code, donc ce sera plus simple de comprendre où est-ce qu'il y a une erreur.

    2. Est-ce que gymnase, association, jour, heurede, heurea sont des cellules nommées ?
    Tu passes par des variables intermédiaires (lafeuille, lassociation, lejour, lheurede, lheurea). Si tu veux, mais c'est pas vraiment utile.

    3. Je ne comprends pas ce que tu fais avec hde et ha ? Je te retranscris ce que tu écris :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    Cells(ligne, 5).Select
    ActiveCell.Value = lheurea
    ha = ActiveCell.Value
    Du coup, par transitivité ha = lheurea, non ?
    Attention, dans ton code tu multiplies les variables. Ce n'est pas faux, mais tu as un tas de variables qui ne sont pas vraiment utiles ou redondantes. Tu risques de t'emmêler les pattes.

    4. Attention parfois, tu écris Sheets("Recap") et parfois Sheets("Récap"). Quel est le bon nom ?

    5. Quand tu écris ça :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    '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
    Est-ce que ton but est de trouver la cellule en colonne A qui contient la valeur hde ? Alors ne passe pas par une boucle ! Il y a plus simple et plus rapide => Find.

    6. Dans l'ensemble des Case, je comprends que tu cherches s'il y a une cellule non vide. Idem n'utilise pas une boucle, mais l'équivalent en VBA de NBVAL.
    => NBVAL = compte le nombre de cellules non vides dans une plage
    => équivalent en VBA : Application.CountA


    7. Offset(0,0) ne sert à rien.

    En corrigeant tout ça, on obtient :
    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
    Private Sub Valider_Click()
        Dim hde As String
        Dim ha As String
        Dim valhde As String
        Dim valha As String
     
        Dim lignede As Variant
        Dim plageSel As Range
     
        'Reservation.Hide
        'Application.ScreenUpdating = False
        lafeuille = gymnase.Value
        lassociation = association.Value
        lejour = jour.Value
        lheurede = "'" & heurede.Value
        lheurea = "'" & heurea.Value
     
        Call TraitementAssoc
     
        With Sheets("Recap")
            ligne = .Range("A1").End(xlDown).Offset(1, 0).Row
     
            .Range("A" & ligne).Value = lafeuille
            .Cells(ligne, 2).Value = lassociation
            .Cells(ligne, 3).Value = lejour
            .Cells(ligne, 4).Value = lheurede
            .Cells(ligne, 5).Value = lheurea
        End With
     
        With Sheets(lafeuille)
            'Détermination de la ligne de et de la ligne à pour le planing
            lignede = .Range("A:A").Find(lheurede).Row
            If IsError(lignede) Then MsgBox "HDE pas trouvé": Exit Sub
     
            lignea = .Range("A:A").Find(lheurea).Row
            If IsError(lignea) Then MsgBox "HA pas trouvé": Exit Sub
     
            'Recherche dans planing si la plage a affecter est deja prise
            vide = 0
            Select Case lejour
                Case "Lundi"
                    If Application.CountA(Range(.Cells(lignede, 3), .Cells(lignea, 3))) > 0 Then vide = 1
                    Set plageSel = Range(.Cells(lignede, 3), .Cells(lignea, 3))
     
                Case "Mardi"
                    If Application.CountA(Range(.Cells(lignede, 4), .Cells(lignea, 4))) > 0 Then vide = 1
                    Set plageSel = Range(.Cells(lignede, 4), .Cells(lignea, 4))
     
                Case "Mercredi"
                    If Application.CountA(Range(.Cells(lignede, 5), .Cells(lignea, 5))) > 0 Then vide = 1
                    Set plageSel = Range(.Cells(lignede, 5), .Cells(lignea, 5))
     
                Case "Jeudi"
                    If Application.CountA(Range(.Cells(lignede, 6), .Cells(lignea, 6))) > 0 Then vide = 1
                    Set plageSel = Range(.Cells(lignede, 6), .Cells(lignea, 6))
     
                Case "Vendredi"
                    If Application.CountA(Range(.Cells(lignede, 7), .Cells(lignea, 7))) > 0 Then vide = 1
                    Set plageSel = Range(.Cells(lignede, 7), .Cells(lignea, 7))
     
                Case "Samedi"
                    If Application.CountA(Range(.Cells(lignede, 8), .Cells(lignea, 8))) > 0 Then vide = 1
                    Set plageSel = Range(.Cells(lignede, 8), .Cells(lignea, 8))
     
                Case "Dimanche"
                    If Application.CountA(Range(.Cells(lignede, 9), .Cells(lignea, 9))) > 0 Then vide = 1
                    Set plageSel = Range(.Cells(lignede, 9), .Cells(lignea, 9))
     
            End Select
        End With
     
        If vide = 1 Then
            MsgBox "Plage déjà occupée partiellement ou en totalité!!!"
            Sheets("Recap").Range("A1").End(xlDown).EntireRow.Delete
            Exit Sub
        End If
     
        'Affectation de la plage mise en gras ecriture bleue et fusion des cellules
        plageSel.Borders(xlInsideHorizontal).LineStyle = xlNone
        With plageSel
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = True
            .Orientation = 0
            .ShrinkToFit = False
            .MergeCells = True
        End With
        With plageSel.Font
            .Name = "Arial"
            .FontStyle = "Gras"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = 5
        End With
            plageSel.Value = lassociation
    End Sub
    Ton Case alourdi beaucoup le code => tu fais exactement la même chose pour chaque cas, seulement la colonne change. En fait, que ce soit pour Case ou une condition If, si tu te rends compte que tu fais exactement la même chose dans chaque condition, à une variable prêt, c'est que tu peux sûrement simplifier. Ici, tu peux prendre une variable col qui te permettra juste de récupérer la colonne en fonction du jour.

    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
    Private Sub Valider_Click()
        Dim hde As String
        Dim ha As String
        Dim valhde As String
        Dim valha As String
     
        Dim lignede As Variant
        Dim plageSel As Range
        Dim col As Integer
     
        'Reservation.Hide
        'Application.ScreenUpdating = False
        lafeuille = gymnase.Value
        lassociation = association.Value
        lejour = jour.Value
        lheurede = "'" & heurede.Value
        lheurea = "'" & heurea.Value
     
        Call TraitementAssoc
     
        With Sheets("Recap")
            ligne = .Range("A1").End(xlDown).Offset(1, 0).Row
     
            .Range("A" & ligne).Value = lafeuille
            .Cells(ligne, 2).Value = lassociation
            .Cells(ligne, 3).Value = lejour
            .Cells(ligne, 4).Value = lheurede
            .Cells(ligne, 5).Value = lheurea
        End With
     
        With Sheets(lafeuille)
            'Détermination de la ligne de et de la ligne à pour le planing
            lignede = .Range("A:A").Find(lheurede).Row
            If IsError(lignede) Then MsgBox "HDE pas trouvé": Exit Sub
     
            lignea = .Range("A:A").Find(lheurea).Row
            If IsError(lignea) Then MsgBox "HA pas trouvé": Exit Sub
     
            'Recherche dans planing si la plage a affecter est deja prise
            vide = 0
            Select Case lejour
                Case "Lundi"
                    col = 3
                Case "Mardi"
                    col = 4
                Case "Mercredi"
                    col = 5
                Case "Jeudi"
                    col = 6
                Case "Vendredi"
                    col = 7
                Case "Samedi"
                    col = 8
                Case "Dimanche"
                    col = 9
            End Select
     
            If Application.CountA(Range(.Cells(lignede, col), .Cells(lignea, col))) > 0 Then vide = 1
            Set plageSel = Range(.Cells(lignede, col), .Cells(lignea, col))
     
        End With
     
        If vide = 1 Then
            MsgBox "Plage déjà occupée partiellement ou en totalité!!!"
            Sheets("Recap").Range("A1").End(xlDown).EntireRow.Delete
            Exit Sub
        End If
     
        'Affectation de la plage mise en gras ecriture bleue et fusion des cellules
        plageSel.Borders(xlInsideHorizontal).LineStyle = xlNone
        With plageSel
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = True
            .Orientation = 0
            .ShrinkToFit = False
            .MergeCells = True
        End With
        With plageSel.Font
            .Name = "Arial"
            .FontStyle = "Gras"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = 5
        End With
            plageSel.Value = lassociation
    End Sub
    Tout cela est à tester pas à pas

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2010] Pb fichier réservation de chambres
    Par Aeque dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 06/05/2011, 13h29
  2. fichier mappé en mémoire
    Par WinBernardo dans le forum Delphi
    Réponses: 7
    Dernier message: 01/12/2006, 09h38
  3. Réponses: 5
    Dernier message: 20/08/2002, 18h01
  4. Lire 1 bit d'un fichier en C
    Par Anonymous dans le forum C
    Réponses: 3
    Dernier message: 23/05/2002, 18h31
  5. Fichier PDOXUSRS.NET
    Par yannick dans le forum Paradox
    Réponses: 5
    Dernier message: 05/04/2002, 09h45

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo