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 :

Excel VBA - Données, Dico, et MsgBox [XL-2007]


Sujet :

Macros et VBA Excel

  1. #1
    Membre averti
    Homme Profil pro
    Étudiant
    Inscrit en
    Mai 2011
    Messages
    18
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Mai 2011
    Messages : 18
    Par défaut Excel VBA - Données, Dico, et MsgBox
    Bonjour à tous,

    Je suis actuellement en train de travailler sur la construction d’un emploi du temps intelligent et multifonctionnel. En tant qu’étudiant, j’en profite du coup pour me former au VBA sur Excel.

    Afin de mieux comprendre la situation, je vais décrire mon fichier. J’ai deux premiers onglets administratifs, qui comportent des paramètres bateaux pour excel, dont un tableauA, dont chaque ligne comprend le nom d’un prof, une heure de debut, de fin, et un cours. Ces informations sont ensuite répercutées dans l’onglet qui lui est destiné sous une autre forme. Ce tableauA est appelé à compter plusieurs lignes, et ce qui m’intéresse désormais maintenant, c’est de créer une macro qui me permettraient de connaître quel prof serait dispos avec les critères établis. Je vous laisse lire le code ci-dessous.

    Mais mon code ne marche pas, et je désespère un peu là…

    Je me suis permis de publier ce post sur plusieurs forums. Ne vous en sentez pas offusqués, c’est juste pour pouvoir étudier les différents réponses qui me seraient proposées.

    Cordialement,

    Guillaume

    Fichier Sans Macro : http://www.cijoint.fr/cjlink.php?fil...ijPgt9PDG.xlsx
    Fichier XL2007 avec Macro : http://www.cijoint.fr/cjlink.php?fil...ijkTrTRU1.xlsm
    Fichier XL 97-2003 : http://www.cijoint.fr/cjlink.php?fil...cijU6pNyng.xls

    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
    Option Explicit
     
    Sub QuiEstDispo()
     
    Dim ValeurRecherche, RangePlage
    Dim Jour As String, Debut As String, Fin As String
    Dim Colonne As Integer, RangeeD As Integer, RangeeF As Integer
    Dim NomdeProf As Range
     
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
     
    Set DicoProfs = CreateObject("Scripting.Dictionary")
     
    Jour = InputBox("Ecrivez un jour : Lundi, Mardi, Mercredi, Jeudi, Vendredi, Samedi", "Quel jour vous intéresse?") 'définit le jour intéressant
     
    Select Case Jour
        Case "Lundi": Colonne = 3
        Case "Mardi": Colonne = 4
        Case "Mercredi": Colonne = 5
        Case "Jeudi": Colonne = 6
        Case "Vendredi": Colonne = 7
        Case "Samedi": Colonne = 8
        Case Else
            MsgBox "Veuillez indiquer un jour de la semaine correct!"
            Exit Sub
    End Select
     
    Debut = InputBox("De quelle heure? - Format : XX:XX:XX ") 'définit le début de la plage horaire
     
    Select Case Debut
        Case "08:00:00": RangeeD = 4
        Case "08:30:00": RangeeD = 5
        Case "09:00:00": RangeeD = 6
        Case "09:30:00": RangeeD = 7
        Case "10:00:00": RangeeD = 8
        Case "10:30:00": RangeeD = 9
        Case "11:00:00": RangeeD = 10
        Case "11:30:00": RangeeD = 11
        Case "12:00:00": RangeeD = 12
        Case "12:30:00": RangeeD = 13
        Case "13:00:00": RangeeD = 14
        Case "13:30:00": RangeeD = 15
        Case "14:00:00": RangeeD = 16
        Case "14:30:00": RangeeD = 17
        Case "15:00:00": RangeeD = 18
        Case "15:30:00": RangeeD = 19
        Case "16:00:00": RangeeD = 20
        Case "16:30:00": RangeeD = 21
        Case "17:00:00": RangeeD = 22
        Case "17:30:00": RangeeD = 23
        Case "18:00:00": RangeeD = 24
    Case Else
            MsgBox "Veuillez indiquer un horaire correct! - Format : XX:XX:XX "
            Exit Sub
    End Select
     
    Fin = InputBox("Jusqu'à quelle heure? - Format : XX:XX:XX ") 'définit la fin de la plage horaire
    Select Case Fin
        Case "08:00:00": RangeeF = 4
        Case "08:30:00": RangeeF = 5
        Case "09:00:00": RangeeF = 6
        Case "09:30:00": RangeeF = 7
        Case "10:00:00": RangeeF = 8
        Case "10:30:00": RangeeF = 9
        Case "11:00:00": RangeeF = 10
        Case "11:30:00": RangeeF = 11
        Case "12:00:00": RangeeF = 12
        Case "12:30:00": RangeeF = 13
        Case "13:00:00": RangeeF = 14
        Case "13:30:00": RangeeF = 15
        Case "14:00:00": RangeeF = 16
        Case "14:30:00": RangeeF = 17
        Case "15:00:00": RangeeF = 18
        Case "15:30:00": RangeeF = 19
        Case "16:00:00": RangeeF = 20
        Case "16:30:00": RangeeF = 21
        Case "17:00:00": RangeeF = 22
        Case "17:30:00": RangeeF = 23
        Case "18:00:00": RangeeF = 24
    Case Else
            MsgBox "Veuillez indiquer un horaire correct! - Format : XX:XX:XX "
            Exit Sub
    End Select
     
    RangePlage = Range(Cells(RangeeD, Colonne), Cells(RangeeF, Colonne)).Address 'est censée représenter la plage horaire du jour défini pour l'analyse ci-dessous
     
    ' dans ce qui suit, je cherche à sélectionner les profs suivants ces critères:
    '  - en respectant la rangeplage : plage horaire choisie, selon le jour qui convient
    '  - en ignorant les cases qui sont coloriées. Elles signifient que le professeur s'est mis en indisponibilités à ce moment là.
    '  - en ignorant les cases qui sont déjà pleines, car s'ils ont déjà un cours, ils ne sont pas dispos pour un nouveau cours!
    '  - si les critères ci-dessus sont respectés, alors la macro enregistre le nom du prof, en E1 sur chaque onglet de prof, et me l'enregistre dans DicoProfs
    'alors, ma MsgBox me donne au final la liste des profs répondant à tous les critères ci-dessus
     
    For Each ValeurRecherche In Range(RangePlage)
        If Not DicoProfs.Exists(Cells(1, 5).Value) And
            With ValeurRecherche
            .Value = ""
            .Selection.Interior.Pattern = xlNone
            End With
        Then DicoProfs.Add Cells(1, 5).Value, Cells(1, 5).Value
        End If
    Next ValeurRecherche
     
    MsgBox (Application.Transpose(DicoProfs.Items))
     
    End Sub

  2. #2
    Membre averti
    Homme Profil pro
    Étudiant
    Inscrit en
    Mai 2011
    Messages
    18
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Mai 2011
    Messages : 18
    Par défaut
    Les gars, je vous remercie de votre temps... On vient de me filer ça sur un autre forum, je le partage avec vous!

    BOnne analyse!


    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
    Option Explicit
     
     
     
    Sub QuiEstDispo()
     
    Dim ValeurRecherche, RangePlage
    Dim Jour As String, Debut As String, Fin As String
    Dim Colonne As Integer, RangeeD As Integer, RangeeF As Integer
    Dim NomdeProf As Range
    Dim dicoprofs As Object
    Dim curSheet As Worksheet
    Dim curligne As Integer
    Dim result() As String
    Dim BreakBoucle As Boolean
    Dim I As Integer
    Dim reponse As String
     
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
     
    Set dicoprofs = CreateObject("Scripting.Dictionary")
     
    Jour = InputBox("Ecrivez un jour : Lundi, Mardi, Mercredi, Jeudi, Vendredi, Samedi", "Quel jour vous intéresse?") 'définit le jour intéressant
     
    Select Case Jour
        Case "Lundi", "lundi": Colonne = 3
        Case "Mardi", "mardi": Colonne = 4
        Case "Mercredi", "mercredi": Colonne = 5
        Case "Jeudi", "jeudi": Colonne = 6
        Case "Vendredi", "vendredi": Colonne = 7
        Case "Samedi", "samedi": Colonne = 8
        Case Else
            MsgBox "Veuillez indiquer un jour de la semaine correct!"
            Exit Sub
    End Select
     
    Debut = InputBox("De quelle heure? - Format : XX:XX ") 'définit le début de la plage horaire
     
    Select Case Debut
        Case "08:00": RangeeD = 4
        Case "08:30": RangeeD = 5
        Case "09:00": RangeeD = 6
        Case "09:30": RangeeD = 7
        Case "10:00": RangeeD = 8
        Case "10:30": RangeeD = 9
        Case "11:00": RangeeD = 10
        Case "11:30": RangeeD = 11
        Case "12:00": RangeeD = 12
        Case "12:30": RangeeD = 13
        Case "13:00": RangeeD = 14
        Case "13:30": RangeeD = 15
        Case "14:00": RangeeD = 16
        Case "14:30": RangeeD = 17
        Case "15:00": RangeeD = 18
        Case "15:30": RangeeD = 19
        Case "16:00": RangeeD = 20
        Case "16:30": RangeeD = 21
        Case "17:00": RangeeD = 22
        Case "17:30": RangeeD = 23
        Case "18:00": RangeeD = 24
    Case Else
            MsgBox "Veuillez indiquer un horaire correct! - Format : XX:XX:XX "
            Exit Sub
    End Select
     
    Fin = InputBox("Jusqu'à quelle heure? - Format : XX:XX ") 'définit la fin de la plage horaire
    Select Case Fin
        Case "08:00": RangeeF = 4
        Case "08:30": RangeeF = 5
        Case "09:00": RangeeF = 6
        Case "09:30": RangeeF = 7
        Case "10:00": RangeeF = 8
        Case "10:30": RangeeF = 9
        Case "11:00": RangeeF = 10
        Case "11:30": RangeeF = 11
        Case "12:00": RangeeF = 12
        Case "12:30": RangeeF = 13
        Case "13:00": RangeeF = 14
        Case "13:30": RangeeF = 15
        Case "14:00": RangeeF = 16
        Case "14:30": RangeeF = 17
        Case "15:00": RangeeF = 18
        Case "15:30": RangeeF = 19
        Case "16:00": RangeeF = 20
        Case "16:30": RangeeF = 21
        Case "17:00": RangeeF = 22
        Case "17:30": RangeeF = 23
        Case "18:00": RangeeF = 24
    Case Else
            MsgBox "Veuillez indiquer un horaire correct! - Format : XX:XX:XX "
            Exit Sub
    End Select
     
    ' RangePlage = Range(Cells(RangeeD, Colonne), Cells(RangeeF, Colonne)).Address 'est censée représenter la plage horaire du jour défini pour l'analyse ci-dessous
     
    ' dans ce qui suit, je cherche à sélectionner les profs suivants ces critères:
    '  - en respectant la rangeplage : plage horaire choisie, selon le jour qui convient
    '  - en ignorant les cases qui sont coloriées. Elles signifient que le professeur s'est mis en indisponibilités à ce moment là.
    '  - en ignorant les cases qui sont déjà pleines, car s'ils ont déjà un cours, ils ne sont pas dispos pour un nouveau cours!
    '  - si les critères ci-dessus sont respectés, alors la macro enregistre le nom du prof, en E1 sur chaque onglet de prof, et me l'enregistre dans DicoProfs
    'alors, ma MsgBox me donne au final la liste des profs répondant à tous les critères ci-dessus
    ReDim result(0)
    result(0) = ""
    For Each curSheet In Sheets
        If curSheet.Name <> "Administratif" And curSheet.Name <> "Cours" Then
            curSheet.Activate
            BreakBoucle = False
            For curligne = RangeeD To RangeeF
                If GetValue(translateCoord(curligne, Colonne)) = "" Then
                    If Selection.Interior.Pattern <> xlNone Then
                        BreakBoucle = True
                        Exit For
                    End If
                Else
                    BreakBoucle = True
                    Exit For
                End If
            Next curligne
            If Not BreakBoucle Then
                result(UBound(result)) = GetValue(translateCoord(1, 5))
                ReDim Preserve result(UBound(result) + 1)
            End If
        End If
    Next
    If UBound(result) > 0 Then ReDim Preserve result(UBound(result) - 1)
    Sheets("Cours").Activate
    If result(0) <> "" Then
        reponse = "liste des personnes dispo:"
        For I = 0 To UBound(result)
            reponse = reponse + vbCrLf + result(I)
        Next I
        MsgBox (reponse)
    Else
        MsgBox "personne de dispo"
    End If
    End Sub
     
    Private Function translateCoord(NumLine As Integer, NumCol As Integer) As String
        translateCoord = TranslateNumColIntoChar(NumCol) & Trim(Str(NumLine))
    End Function
    Private Function TranslateNumColIntoChar(NumCol As Integer) As String
    Dim Reste As Long
     
        If NumCol <= 26 Then
            TranslateNumColIntoChar = Chr(Asc("A") + NumCol - 1)
        Else
            Reste = (NumCol - 1) Mod 26
            TranslateNumColIntoChar = Chr(Asc("A") + Int((NumCol - 1) / 26) - 1) & Chr(Asc("A") + Reste)
        End If
    End Function
    Private Function GetValue(cellule As String) As Variant
        Range(cellule).Select
        GetValue = ActiveCell.Value
    End Function

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

Discussions similaires

  1. [VBA EXCEL] Importation données Web
    Par pwrollez dans le forum Macros et VBA Excel
    Réponses: 9
    Dernier message: 23/02/2007, 08h27
  2. [VBA Excel] - Copie données entre feuilles
    Par mimic50 dans le forum VBA Access
    Réponses: 1
    Dernier message: 27/11/2006, 13h43
  3. erreur de conexion a une base de donneés access avec excel(vba)
    Par leo13 dans le forum Macros et VBA Excel
    Réponses: 15
    Dernier message: 27/11/2006, 09h09
  4. [VBA-EXCEL]-condition pour ouvrir une msgbox
    Par captaine93 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 29/08/2006, 20h51
  5. [VBA-E]replacement données excel par données VBA
    Par plante.douce dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 02/04/2006, 20h23

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