API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Apr 13th, 2012
83
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 18.13 KB | None | 0 0
raw download clone embed print report
  1. Sub Macrosaq()
  2. Application.ScreenUpdating = False
  3. ' Macro4 Macro
  4. ' Macro enregistrée le 13/04/2012 par 8606174m
  5.  
  6. 'Information :
  7. ' While : Le While est une boucle qui fait le tour des informations contenu dans les cellules
  8. ' ~ : Ce sigle au début d'un commentaire indique la fermeture d'une requête (précédemment commenté)
  9.  
  10.  
  11.     'Paramètrage des données de base :
  12.    i = 2
  13.    
  14.     'On Selectionne la feuille "SAQ extérieur" (like : ctrl+A)
  15.    Sheets("SAQ Extérieur").Select
  16.    
  17.         'On va référencer les données en fonction du n° de l'engin : no_engin & de sa série
  18.            no_engin = format_engin(Sheets("SAQ Extérieur").Cells(i, 1).Value, Sheets("SAQ Extérieur").Cells(i, 2).Value)
  19.            
  20.    
  21.         'On relève l'opération de maintenance de l'engin selectionné précedemment.
  22.            Dim operation As String
  23.             operation = Sheets("SAQ Extérieur").Cells(i, 5).Value
  24.        
  25.         'On récupère la valeur de la durée d'immobilisation
  26.            Dim duree7j As String
  27.             duree7j = Sheets("SAQ Extérieur").Cells(i, 13).Value
  28.        
  29.         'On récupère les infos de la semaine et de l'année d'entrée
  30.            annee_entree = Sheets("SAQ Extérieur").Cells(i, 4).Value 'Retourne la donnée brut (ex: jj/mm/aaaa hh:mm:ss)'.
  31.            Dim A1 As String
  32.             A1 = Mid(annee_entree, 7, 4) 'Extrait de "annee_entree" uniquement l'année en question'.
  33.            semaine_entree = Sheets("SAQ Extérieur").Cells(i, 14).Value 'Retourne le numéro de la semaine d'entrée'.
  34.                      annee_rat = Sheets("SAQ Extérieur").Cells(i, 7).Value 'Retourne la donnée brut (ex: jj/mm/aaaa hh:mm:ss)'.
  35.                    Dim a2 As String
  36.                     a2 = Mid(annee_rat, 7, 4) 'Extrait de "annee_rat" uniquement l'année en question'.
  37.                    semaine_rat = Sheets("SAQ Extérieur").Cells(i, 15).Value 'Retourne le numéro de la semaine de remise à temps'.
  38.    
  39.         'On passe à la ligne d'après
  40.            While Sheets("SAQ Extérieur").Cells(i, 1) <> ""
  41.    
  42.                     i = i + 1
  43.             Wend
  44.    
  45.     'On refais la selection de la feuille "SAQ Extérieur"
  46.        Sheets("SAQ Extérieur").Select
  47.         Sheets("SAQ Extérieur").Range("A2:u" & i).Select
  48.  
  49.  
  50.  
  51.  
  52.  
  53.     ' -------------------------------------------------------------------------------------'
  54.    ' 2ème Etapes :                                                                        '
  55.    ' Vérification que c'est un engin listé dans la feuille "Post_ext"                     '
  56.    ' On collecte ainsi les données "année & semaines " de début et de fin d'intervention. '
  57.    ' -------------------------------------------------------------------------------------'
  58.    ' PS: On as une particularité pour les engins étant immobilisé depuis 2011.            '
  59.    '--------------------------------------------------------------------------------------'
  60.        
  61.     'Remplissage tableau prog
  62.    ligne_engin = 0 'On saisie une valeur NULL'
  63.    ligne = 5 'On commence à vérifier à partir de la ligne 6 (début des données brut)'
  64.    col = 5
  65.  
  66.  
  67.     'On selectionne la feuille "Post_ext"
  68.    Sheets("Post_ext").Select
  69.    
  70.     'On fait la boucle pour récupérer les données de la feuille "Post_ext"
  71.    While Sheets("Post_ext").Cells(ligne, 2) <> ""
  72.        
  73.         'Si on trouve une ligne dont la valeur est égale au N° de l'engin recherché :
  74.        If Sheets("Post_ext").Cells(ligne, 4).Value = no_engin Then
  75.        
  76.             'On défini par positif la présence de l'engin dans la flotte prog.
  77.            'La ligne de l'engin dans la feuille est donc selectionné et identifié en "ligne_engin".
  78.            ligne_engin = ligne
  79.              
  80.              
  81.             '---------------------------------------------------'
  82.            '                                                   '
  83. '---(info)--'       Particularité pour l'année 2011             '
  84.            '                                                   '
  85.            '---------------------------------------------------'
  86.            'Si on trouve l'année identique à l'année présenté en annee_entree :
  87.            If A1 = 2011 Then
  88.              
  89.                 Dim A2012 As String
  90.        
  91.                 A2012 = Replace(annee_entree, annee_entree, "01/01/2012")
  92.                     'On Extrait de "annee_entree" uniquement l'année en question'
  93.                    A1 = Mid(A2012, 7, 4)
  94.                 semaine_entree = 1
  95.            
  96.            
  97.                     '------------------------------------'
  98.                    'MsgBox ("Date 2011 Modifié en 2012") '
  99.                    '   Flag de test de modification     '
  100.                    '       (Ne pas en tenir compte)     '
  101.                    '------------------------------------'
  102.            End If
  103.             '---------------------------------------------------'
  104.            '                                                   '
  105. '---(info)--'       Fin de Particularité pour l'année 2011      '
  106.            '                                                   '
  107.            '---------------------------------------------------'
  108.            
  109.            
  110.             'On saisie la valeur de A6 mais dans un String afin d'avoir une valeur Brut.
  111.            Dim A6 As String
  112.             A6 = Sheets("Post_ext").Cells(2, col).Value
  113.            
  114.             'Si on trouve l'année identique à l'année présenté en annee_entree :
  115.            If A1 = A6 Then
  116.            
  117.                 'Si la cellule est identique à semaine_entree :
  118.                If (Sheets("Post_ext").Cells(4, col).Value = semaine_entree) Then
  119.                    
  120.                    
  121.                     '------------------------------------------'
  122.                    '   Maintenant qu'on as la date de début   '
  123.                    '       On prend la date de fin            '
  124.                    '               d'opération                '
  125.                    '------------------------------------------'
  126.                    
  127.                     'On récupère les infos de la semaine  et de l'année Remise à Temps
  128.                    col_fin = 5 'On commence à vérifier la fin à partir de la première colonne d'intervention.
  129.                    sem_fin = 5 'On commence à vérifier la fin à partir de la première colonne d'intervention.
  130.                    
  131.                     'On fait une boucle pour trouver la cellule de fin d'intervention
  132.                    While Sheets("Post_ext").Cells(ligne_engin, col_fin) <> ""
  133.                    
  134.                         'on cherche la cellule correspondant à l'année de "remise à temps".
  135.                        If (Sheets("Post_ext").Cells(2, col_fin) = a2) Then
  136.  
  137.                             'une fois trouvé, on cherche la cellule correspondante à la semaine de "remise à temps".
  138.                            If (Sheets("Post_ext").Cells(4, sem_fin) = semaine_rat) Then
  139.                                  'Une fois trouvé, on l'identifie pour plus tard
  140.                                                                
  141.                                 range_fin = getCell(ligne_engin, sem_fin)
  142.                                  
  143.                             End If '~Si on trouve pas la semaine de rat, on rajoute +1 et on passe à la colonne suivante :
  144.                            sem_fin = sem_fin + 1
  145.                            
  146.                         End If '~Si on trouve pas l'année de rat, on rajoute +1 et on passe à la colonne suivante :
  147.                            col_fin = col_fin + 1
  148.                     Wend
  149.                    
  150.                    
  151.     ' ---------------------------------------------------------------------------------------------'
  152.    ' 3ème Etapes :                                                                                '
  153.    ' Désormais on va inscrire la ligne de l'engin en fonction des données collectés               '
  154.    ' Et si jamais la ligne contient déja une valeur, on écrira dans une nouvelle ligne au dessous '
  155.    '----------------------------------------------------------------------------------------------'
  156.                    
  157.                    
  158.                     'On vérifie si l'opération de saisi et la même que dans sa ligne de destination'
  159.                    If Sheets("Post_ext").Cells(ligne_engin, col).Value = operation Then
  160.  
  161.                         '---------------------------------------------------------------------------------'
  162.                        'Si c'est le cas, alors on ne va pas mettre à jour les données pour cette ligne.  '
  163.                        '---------------------------------------------------------------------------------'
  164.                      Else
  165.                      
  166.    
  167.  
  168.                        
  169.                          'sinon on vérifie la ligne suivante pour savoir si elle appartient elle aussi au même engin'
  170.                            If Sheets("Post_ext").Cells(ligne_engin + 1, 4).Value = no_engin Then
  171.                        
  172.  
  173.                                 'Si elle appartient aussi au même engin, on recommence la même opération :
  174.                                'On vérifie si l'opération a écrire se situe dans la cellule "operation"
  175.                                If InStr(1, Sheets("Post_ext").Cells(ligne_engin + 1, col).Value, Trim(operation), 1) > 0 Then
  176.                                     ligne_engin = ligne_engin + 1
  177.                                     '---------------------------------------------------------------------------------'
  178.                                    'Si c'est le cas, alors on ne va pas mettre à jour les données pour cette ligne.  '
  179.                                    '---------------------------------------------------------------------------------'
  180.    
  181.    
  182.                                 Else ' Si ce n'est pas le cas, alors on va vérifier si la plage d'intervention de la ligne n'est pas vide :
  183.                                    range_debut = getCell(ligne_engin + 1, col)
  184.                                     If IsEmpty(range_debut) = True Then
  185.                                     '---------------------------------------------------------------------------------'
  186.                                    'Si c'est le cas, alors on ne va pas mettre à jour les données pour cette ligne.  '
  187.                                    '---------------------------------------------------------------------------------'
  188.                                    
  189.      
  190.                                     Else 'Elle contient une information, alors :
  191.                                        '---------------------------------------------------------------------------------'
  192.                                        '           on as trouvé l'emplacement pour l'intervention alors                  '
  193.                                        '               on écrit les données dans la ligne en question.                   '
  194.                                        '---------------------------------------------------------------------------------'
  195.                            '-----------------'
  196.                            ' création ligne  '
  197.                            '-----------------'
  198.                                    ligne_d_ajout = "" & (ligne_engin + 1) & ":" & (ligne_engin + 1) & ""
  199.                                     Sheets("Post_ext").Select
  200.                                     Rows(ligne_d_ajout).Select
  201.                                     Selection.Insert Shift:=xlDown
  202.                                     range_debut = getCell(ligne_engin + 1, col)
  203.                                     Sheets("Post_ext").Cells(ligne_engin + 1, 1).Value = Sheets("Post_ext").Cells(ligne_engin, 1).Value
  204.                                     Sheets("Post_ext").Cells(ligne_engin + 1, 2).Value = Sheets("Post_ext").Cells(ligne_engin, 2).Value
  205.                                     Sheets("Post_ext").Cells(ligne_engin + 1, 3).Value = Sheets("Post_ext").Cells(ligne_engin, 3).Value
  206.                                     Sheets("Post_ext").Cells(ligne_engin + 1, 4).Value = Sheets("Post_ext").Cells(ligne_engin, 4).Value
  207.                                     Sheets("Post_ext").Cells(ligne_engin + 1, col).Value = operation
  208.  
  209.                                     ligne_engin = ligne_engin + 1
  210.                                    
  211.                                        
  212.                                     End If '~End de : écrit les données.
  213.                                End If
  214.  
  215.                            
  216.                         Else 'Si ce n'est pas la ligne du même engin :
  217.                        
  218.                                     '---------------------------------------------------------------------------------'
  219.                                    '           On n'as pas trouvé de place dans les précédentes lignes de l'engin    '
  220.                                    '               pour pouvoir écrire les données dans la ligne en question.        '
  221.                                    '                   alors on va simplement insérer une nouvelle ligne             '
  222.                                    '                           pour l'engin qui nous interesse.
  223.                                    '---------------------------------------------------------------------------------'
  224.                        
  225.                             '-----------------'
  226.                            ' création ligne  '
  227.                            '-----------------'
  228.                                    ligne_d_ajout = "" & (ligne_engin + 1) & ":" & (ligne_engin + 1) & ""
  229.                                     Sheets("Post_ext").Select
  230.                                     Rows(ligne_d_ajout).Select
  231.                                     Selection.Insert Shift:=xlDown
  232.                                     range_debut = getCell(ligne_engin + 1, col)
  233.                             '--------------------------'
  234.                            ' Inscriptions des données '
  235.                            '--------------------------'
  236.                                    Sheets("Post_ext").Cells(ligne_engin + 1, 1).Value = Sheets("Post_ext").Cells(ligne_engin, 1).Value
  237.                                     Sheets("Post_ext").Cells(ligne_engin + 1, 2).Value = Sheets("Post_ext").Cells(ligne_engin, 2).Value
  238.                                     Sheets("Post_ext").Cells(ligne_engin + 1, 3).Value = Sheets("Post_ext").Cells(ligne_engin, 3).Value
  239.                                     Sheets("Post_ext").Cells(ligne_engin + 1, 4).Value = Sheets("Post_ext").Cells(ligne_engin, 4).Value
  240.                                     Sheets("Post_ext").Range(Cells(ligne_engin + 1, col), Cells(ligne_engin + 1, sem_fin - 1)).Value = operation
  241.  
  242.                                    
  243.                                     'Si la durée d'immobilisation de la cellule 13 : "Jour d'immob" est supérieur ou égal à 6Jours
  244.                                    If (duree7j > 6) Then
  245.                                    
  246.  
  247.                                         'On change la couleur de la ligne
  248.                                        Sheets("Post_ext").Range(Cells(ligne_engin + 1, col), Cells(ligne_engin + 1, sem_fin - 1)).Interior.ColorIndex = 3
  249.                                         Sheets("Post_ext").Range(Cells(ligne_engin + 1, col), Cells(ligne_engin + 1, sem_fin - 1)).Font.Bold = True
  250.                                         Sheets("Post_ext").Range(Cells(ligne_engin + 1, col), Cells(ligne_engin + 1, sem_fin - 1)).Font.ColorIndex = 52
  251.                                     End If
  252.  
  253.                                     'Sheets("Post_ext").Cells(ligne_engin + 1, col).Font.Bold = True
  254.                                    
  255.                         End If '~Fin de la création de la ligne'
  256.                            
  257.                          
  258.                        
  259.                        
  260.                     End If '~Fin de : Si même opération'
  261.                
  262.                 End If '~Fin de : identique à semaine_entree, Sinon on passe à la colonne suivante afin de trouvé la semaine correspondante'
  263.                col = col + 1
  264.            
  265.             End If '~Fin de : Si même année, Sinon on passe à la colonne suivante afin de trouvé l'année correspondante'
  266.            col = col + 1
  267.            
  268.  
  269.         ligne = ligne + 1
  270.         i = i + 1
  271.         End If '~Si on n'as pas trouvé l'engin correspondant, on rajoute +1 et on consulte la ligne suivante:'
  272.        
  273.    
  274.     Wend
  275.  
  276.  
  277.    
  278.          
  279.          
  280.             MsgBox ("Boucle Terminé avec succès")
  281.          
  282.          
  283.  
  284.  
  285.  
  286.  
  287.  
  288. End Sub
  289.  
  290. Function format_engin(serie, numero)
  291.     'Cette Function préformatera les case en fonction du type d'engin
  292.    Select Case Left(serie, 2)
  293.     Case "BB"
  294.         format_engin = "BB" & numero
  295.     Case "B8"
  296.         format_engin = "B" & numero
  297.     Case "Y7"
  298.         format_engin = "Y" & numero
  299.     Case "Y8"
  300.         format_engin = "Y" & numero
  301.     Case "X2"
  302.         format_engin = "X" & numero
  303.     Case "X9"
  304.         format_engin = "X" & numero
  305.     Case "XR"
  306.         format_engin = "XR" & numero
  307.     Case "X7"
  308.         format_engin = "X" & numero
  309.     Case "Z2"
  310.         format_engin = "Z" & numero
  311.     Case "Z7"
  312.         format_engin = "Z" & numero
  313.     Case "Z9"
  314.         format_engin = "Z" & numero
  315.     Case Else
  316.         format_engin = Left(serie, 1) & numero
  317.     End Select
  318.    
  319. End Function
  320.  
  321.  
  322. Private Function GetColonnes(ByVal s As String, ByVal n As Integer) As String
  323.     Dim k As Integer
  324.     Dim j As Integer
  325.     Dim c As String
  326.    
  327.     ' il y a 26 lettres dans l'alphabet, donc si on dépasse ce chiffre c'est qu'il faut plusieurs lettres
  328.    If n > 26 Then
  329.         k = Int(n / 26)
  330.         If (n Mod 26) <> 0 Then
  331.             j = n Mod 26
  332.         Else
  333.             j = 26: k = k - 1
  334.         End If
  335.         ' on appelle une nouvelle fois la fonction
  336.        GetColonnes = s + GetColonnes(Chr(64 + k), j) ' 64 correspond au caractère '@' (juste avant 'A')
  337.    Else
  338.         c = Chr(64 + n)
  339.         GetColonnes = s + c
  340.     End If
  341. End Function
  342.  
  343. Public Function getCell(ByVal X As Integer, ByVal Y As Integer) As String
  344.     getCell = GetColonnes("", X) & CStr(Y)
  345. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!