RESOLU - Excel VBA - Données, Dico, et MsgBox

RESOLU - Excel VBA - Données, Dico, et MsgBox - VB/VBA/VBS - Programmation

Marsh Posté le 17-05-2011 à 13:06:40    

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?f [...] t9PDG.xlsx
Fichier XL2007 avec Macro : http://www.cijoint.fr/cjlink.php?f [...] rTRU1.xlsm
Fichier XL 97-2003 : http://www.cijoint.fr/cjlink.php?f [...] 6pNyng.xls
 

Code :
  1. Option Explicit
  2. Sub QuiEstDispo()
  3. Dim ValeurRecherche, RangePlage
  4. Dim Jour As String, Debut As String, Fin As String
  5. Dim Colonne As Integer, RangeeD As Integer, RangeeF As Integer
  6. Dim NomdeProf As Range
  7. With Application
  8.     .ScreenUpdating = False
  9.     .Calculation = xlCalculationManual
  10. End With
  11. Set DicoProfs = CreateObject("Scripting.Dictionary" )
  12. Jour = InputBox("Ecrivez un jour : Lundi, Mardi, Mercredi, Jeudi, Vendredi, Samedi", "Quel jour vous intéresse?" ) 'définit le jour intéressant
  13. Select Case Jour
  14.     Case "Lundi": Colonne = 3
  15.     Case "Mardi": Colonne = 4
  16.     Case "Mercredi": Colonne = 5
  17.     Case "Jeudi": Colonne = 6
  18.     Case "Vendredi": Colonne = 7
  19.     Case "Samedi": Colonne = 8
  20.     Case Else
  21.         MsgBox "Veuillez indiquer un jour de la semaine correct!"
  22.         Exit Sub
  23. End Select
  24.    
  25. Debut = InputBox("De quelle heure? - Format : XX:XX:XX " ) 'définit le début de la plage horaire
  26. Select Case Debut
  27.     Case "08:00:00": RangeeD = 4
  28.     Case "08:30:00": RangeeD = 5
  29.     Case "09:00:00": RangeeD = 6
  30.     Case "09:30:00": RangeeD = 7
  31.     Case "10:00:00": RangeeD = 8
  32.     Case "10:30:00": RangeeD = 9
  33.     Case "11:00:00": RangeeD = 10
  34.     Case "11:30:00": RangeeD = 11
  35.     Case "12:00:00": RangeeD = 12
  36.     Case "12:30:00": RangeeD = 13
  37.     Case "13:00:00": RangeeD = 14
  38.     Case "13:30:00": RangeeD = 15
  39.     Case "14:00:00": RangeeD = 16
  40.     Case "14:30:00": RangeeD = 17
  41.     Case "15:00:00": RangeeD = 18
  42.     Case "15:30:00": RangeeD = 19
  43.     Case "16:00:00": RangeeD = 20
  44.     Case "16:30:00": RangeeD = 21
  45.     Case "17:00:00": RangeeD = 22
  46.     Case "17:30:00": RangeeD = 23
  47.     Case "18:00:00": RangeeD = 24
  48. Case Else
  49.         MsgBox "Veuillez indiquer un horaire correct! - Format : XX:XX:XX "
  50.         Exit Sub
  51. End Select
  52.    
  53. Fin = InputBox("Jusqu'à quelle heure? - Format : XX:XX:XX " ) 'définit la fin de la plage horaire
  54. Select Case Fin
  55.     Case "08:00:00": RangeeF = 4
  56.     Case "08:30:00": RangeeF = 5
  57.     Case "09:00:00": RangeeF = 6
  58.     Case "09:30:00": RangeeF = 7
  59.     Case "10:00:00": RangeeF = 8
  60.     Case "10:30:00": RangeeF = 9
  61.     Case "11:00:00": RangeeF = 10
  62.     Case "11:30:00": RangeeF = 11
  63.     Case "12:00:00": RangeeF = 12
  64.     Case "12:30:00": RangeeF = 13
  65.     Case "13:00:00": RangeeF = 14
  66.     Case "13:30:00": RangeeF = 15
  67.     Case "14:00:00": RangeeF = 16
  68.     Case "14:30:00": RangeeF = 17
  69.     Case "15:00:00": RangeeF = 18
  70.     Case "15:30:00": RangeeF = 19
  71.     Case "16:00:00": RangeeF = 20
  72.     Case "16:30:00": RangeeF = 21
  73.     Case "17:00:00": RangeeF = 22
  74.     Case "17:30:00": RangeeF = 23
  75.     Case "18:00:00": RangeeF = 24
  76. Case Else
  77.         MsgBox "Veuillez indiquer un horaire correct! - Format : XX:XX:XX "
  78.         Exit Sub
  79. End Select
  80. 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
  81. ' dans ce qui suit, je cherche à sélectionner les profs suivants ces critères:
  82. '  - en respectant la rangeplage : plage horaire choisie, selon le jour qui convient
  83. '  - en ignorant les cases qui sont coloriées. Elles signifient que le professeur s'est mis en indisponibilités à ce moment là.
  84. '  - 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!
  85. '  - 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
  86. 'alors, ma MsgBox me donne au final la liste des profs répondant à tous les critères ci-dessus
  87. For Each ValeurRecherche In Range(RangePlage)
  88.     If Not DicoProfs.Exists(Cells(1, 5).Value) And
  89.         With ValeurRecherche
  90.         .Value = ""
  91.         .Selection.Interior.Pattern = xlNone
  92.         End With
  93.     Then DicoProfs.Add Cells(1, 5).Value, Cells(1, 5).Value
  94.     End If
  95. Next ValeurRecherche
  96. MsgBox (Application.Transpose(DicoProfs.Items))
  97. End Sub


Message édité par Guillaume831 le 17-05-2011 à 15:06:42
Reply

Marsh Posté le 17-05-2011 à 13:06:40   

Reply

Marsh Posté le 17-05-2011 à 15:05:48    

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 :
  1. Option Explicit
  2. Sub QuiEstDispo()
  3. Dim ValeurRecherche, RangePlage
  4. Dim Jour As String, Debut As String, Fin As String
  5. Dim Colonne As Integer, RangeeD As Integer, RangeeF As Integer
  6. Dim NomdeProf As Range
  7. Dim dicoprofs As Object
  8. Dim curSheet As Worksheet
  9. Dim curligne As Integer
  10. Dim result() As String
  11. Dim BreakBoucle As Boolean
  12. Dim I As Integer
  13. Dim reponse As String
  14. With Application
  15.     .ScreenUpdating = False
  16.     .Calculation = xlCalculationManual
  17. End With
  18. Set dicoprofs = CreateObject("Scripting.Dictionary" )
  19. Jour = InputBox("Ecrivez un jour : Lundi, Mardi, Mercredi, Jeudi, Vendredi, Samedi", "Quel jour vous intéresse?" ) 'définit le jour intéressant
  20. Select Case Jour
  21.     Case "Lundi", "lundi": Colonne = 3
  22.     Case "Mardi", "mardi": Colonne = 4
  23.     Case "Mercredi", "mercredi": Colonne = 5
  24.     Case "Jeudi", "jeudi": Colonne = 6
  25.     Case "Vendredi", "vendredi": Colonne = 7
  26.     Case "Samedi", "samedi": Colonne = 8
  27.     Case Else
  28.         MsgBox "Veuillez indiquer un jour de la semaine correct!"
  29.         Exit Sub
  30. End Select
  31.    
  32. Debut = InputBox("De quelle heure? - Format : XX:XX " ) 'définit le début de la plage horaire
  33. Select Case Debut
  34.     Case "08:00": RangeeD = 4
  35.     Case "08:30": RangeeD = 5
  36.     Case "09:00": RangeeD = 6
  37.     Case "09:30": RangeeD = 7
  38.     Case "10:00": RangeeD = 8
  39.     Case "10:30": RangeeD = 9
  40.     Case "11:00": RangeeD = 10
  41.     Case "11:30": RangeeD = 11
  42.     Case "12:00": RangeeD = 12
  43.     Case "12:30": RangeeD = 13
  44.     Case "13:00": RangeeD = 14
  45.     Case "13:30": RangeeD = 15
  46.     Case "14:00": RangeeD = 16
  47.     Case "14:30": RangeeD = 17
  48.     Case "15:00": RangeeD = 18
  49.     Case "15:30": RangeeD = 19
  50.     Case "16:00": RangeeD = 20
  51.     Case "16:30": RangeeD = 21
  52.     Case "17:00": RangeeD = 22
  53.     Case "17:30": RangeeD = 23
  54.     Case "18:00": RangeeD = 24
  55. Case Else
  56.         MsgBox "Veuillez indiquer un horaire correct! - Format : XX:XX:XX "
  57.         Exit Sub
  58. End Select
  59.    
  60. Fin = InputBox("Jusqu'à quelle heure? - Format : XX:XX " ) 'définit la fin de la plage horaire
  61. Select Case Fin
  62.     Case "08:00": RangeeF = 4
  63.     Case "08:30": RangeeF = 5
  64.     Case "09:00": RangeeF = 6
  65.     Case "09:30": RangeeF = 7
  66.     Case "10:00": RangeeF = 8
  67.     Case "10:30": RangeeF = 9
  68.     Case "11:00": RangeeF = 10
  69.     Case "11:30": RangeeF = 11
  70.     Case "12:00": RangeeF = 12
  71.     Case "12:30": RangeeF = 13
  72.     Case "13:00": RangeeF = 14
  73.     Case "13:30": RangeeF = 15
  74.     Case "14:00": RangeeF = 16
  75.     Case "14:30": RangeeF = 17
  76.     Case "15:00": RangeeF = 18
  77.     Case "15:30": RangeeF = 19
  78.     Case "16:00": RangeeF = 20
  79.     Case "16:30": RangeeF = 21
  80.     Case "17:00": RangeeF = 22
  81.     Case "17:30": RangeeF = 23
  82.     Case "18:00": RangeeF = 24
  83. Case Else
  84.         MsgBox "Veuillez indiquer un horaire correct! - Format : XX:XX:XX "
  85.         Exit Sub
  86. End Select
  87. ' 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
  88. ' dans ce qui suit, je cherche à sélectionner les profs suivants ces critères:
  89. '  - en respectant la rangeplage : plage horaire choisie, selon le jour qui convient
  90. '  - en ignorant les cases qui sont coloriées. Elles signifient que le professeur s'est mis en indisponibilités à ce moment là.
  91. '  - 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!
  92. '  - 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
  93. 'alors, ma MsgBox me donne au final la liste des profs répondant à tous les critères ci-dessus
  94. ReDim result(0)
  95. result(0) = ""
  96. For Each curSheet In Sheets
  97.     If curSheet.Name <> "Administratif" And curSheet.Name <> "Cours" Then
  98.         curSheet.Activate
  99.         BreakBoucle = False
  100.         For curligne = RangeeD To RangeeF
  101.             If GetValue(translateCoord(curligne, Colonne)) = "" Then
  102.                 If Selection.Interior.Pattern <> xlNone Then
  103.                     BreakBoucle = True
  104.                     Exit For
  105.                 End If
  106.             Else
  107.                 BreakBoucle = True
  108.                 Exit For
  109.             End If
  110.         Next curligne
  111.         If Not BreakBoucle Then
  112.             result(UBound(result)) = GetValue(translateCoord(1, 5))
  113.             ReDim Preserve result(UBound(result) + 1)
  114.         End If
  115.     End If
  116. Next
  117. If UBound(result) > 0 Then ReDim Preserve result(UBound(result) - 1)
  118. Sheets("Cours" ).Activate
  119. If result(0) <> "" Then
  120.     reponse = "liste des personnes dispo:"
  121.     For I = 0 To UBound(result)
  122.         reponse = reponse + vbCrLf + result(I)
  123.     Next I
  124.     MsgBox (reponse)
  125. Else
  126.     MsgBox "personne de dispo"
  127. End If
  128. End Sub
  129. Private Function translateCoord(NumLine As Integer, NumCol As Integer) As String
  130.     translateCoord = TranslateNumColIntoChar(NumCol) & Trim(Str(NumLine))
  131. End Function
  132. Private Function TranslateNumColIntoChar(NumCol As Integer) As String
  133. Dim Reste As Long
  134.     If NumCol <= 26 Then
  135.         TranslateNumColIntoChar = Chr(Asc("A" ) + NumCol - 1)
  136.     Else
  137.         Reste = (NumCol - 1) Mod 26
  138.         TranslateNumColIntoChar = Chr(Asc("A" ) + Int((NumCol - 1) / 26) - 1) & Chr(Asc("A" ) + Reste)
  139.     End If
  140. End Function
  141. Private Function GetValue(cellule As String) As Variant
  142.     Range(cellule).Select
  143.     GetValue = ActiveCell.Value
  144. End Function


Message édité par Guillaume831 le 17-05-2011 à 15:06:15
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed