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