Optimisation de macro et correction de MEF conditionnel

[fredd]

Bonjour, j'ai construit un fichier excel dans le cadre de mon boulot pour avoir une tracabilité de suivi de flux documentaire, pour des raison diverse ...

Grace à ce forum, j'ai pu me faire auder sur des formules et sur des macro. Hors j'ai encore besoin d'aide pour optimiser les macro, et dépaner un probleme que je n'arrive pas à gérer et sur des mises en forme conditionnel

j'explique, sur le fichier en piece jointe:
Toute les formules de l'onglet "=( °w° )=_Suivi_=( °w° )=" fonctionnent.

J'ai 4 macro d'automatisation :

• "Archivage"
• "Protéger"
• "Déprotéger"
• "Insertion de ligne"

Le fonctionnement du fichier:
Les colonnes bleu sont des menu déroulant prenant les valeurs dans l'onglet "base"
Les colonnes blanche sont des chant de textes libre
Les colonnes vertes sont des formules.

En B,C,D, c'est un choix du technicien
E, F,G, on renseigne un équipement
H, I,j sont des choix métiers
K, une case de commentaire
L et M servent à suivre le type et l'avancement.
N, O, P, Q, R, nous sert à prioriser manuellement en S
S la priorité.
De T à AE, sont des dates à renseigner, avec des choix pour du NA en W, X, AA, AB
AF, AG, AH, AI sert pour le suivi et la gestion des retard.

Les lignes 2 à 9 sont des calculs de moyennes ou des compteurs, pas encore exploité pour le moment. A voir plus tard ....
Toute les formules sont visibles et fonctionne. ( grace à vous d'ailleurs )

certaines cellules sont protégé sans mot de passe, c'est juste pour limiter des erreurs. Si on choisis d'enlever la protection c'est pour un but précis, comme la suppression d'une ligne.
C'est pour cela que j'ai ajouter 2 bouton de protecton et déprotection de la feuille de travail. Action supplémentaire avant modification.

Mes problèmes:

Macro :

la macro "archivage" est sensé récupérer les ligne ayant la mention "terminé" dans la colonne AF, de la couper et de la coller à la suite dans l'onglet "=( °w° )=_Archive_=( °w° )="

mais j'ai un message d'erreur " l'indice n'appartient pas à la sélection"
J'ai cherché sur le net, c'est assez courant mais je n'arrive pas à réparer.

2 eme point, et je ne comprend pas parce que ça fonctionnais pendant un moment, l'archivage ce fait ligne par ligne. et j'aurais voulu optimiser le temps de l'action.

Macro "insertion d'une ligne"

1 - Je n'arrive pas à apposer par défaut "1 dans la boite de dialogue.

quantite = Application.InputBox("nombre de ligne à inserer", "insertion de ligne", Default = "1", Type:=1)

me donne 0 dans la boite de dialogue

2 - Cette macro insert une ligne et recopie les formules d'en dessus et les mise en formes. le probleme est que les mises en formes conditionnels sont repris de facon individuel.

D'ou mon probleme de mise en forme:

La colonne "Q":
Classe une échelle de couleur en nuance en fonction de la date. Rouge la plus éloigné d'aujourd'hui et vert la plus pret.
hors dans cette MEF, la formule qui est à l'intérieur est "=$Q$10:$Q$164"
A caque fois que j'ajoute une ligne, la plage ne s'agrandi pas, mais la meme formule s'aplique à la cellule seul :et transforme la premiere formule en "=$Q$10:$Q$164;$Q$167" et une pour "=$Q$166" et pour "=$Q$167" par exemple.

Le probleme est identique pour la MEFCondtionnel de la colonne R, AF et AI.

Voilà je ne sais pas si je suis assez clair. et vous remercie par avance.

 

[Pierrot93]

Re : Optimisation de macro et correction de MEF conditionnel

bonjour,

remarque au passage manque : et doit être un nombre si type = 1 :

quantite = Application.InputBox("nombre de ligne à inserer", "insertion de ligne", Default:=1, Type:=1)

bonne journée
@+

 

[fredd]

Re : Optimisation de macro et correction de MEF conditionnel

Merci, j'en prend note. Et du coté de la macro d'archivage? est ce que tu as une idée?

J'ajouterais la structure de VBAProject dans mon post:

Microsoft Excel objets:

• Feuil 2 (=( °w° )=_Suivi_=( °w° )=)

Sub Archiv()
Dim Dec&, Lig&, Cel As Range
If MsgBox("Voulez vous archiver les éléments terminés ?", vbYesNo, "Confirmation") = vbYes Then
  Me.Unprotect
  Set Cel = Me.[AF9]: Dec = 1
  With Worksheets("archive")
    Lig = PremièreCelluleVideSousDernièreCelluleNonVide(.[AF1]).Row
    Do
      Select Case Cel.Offset(Dec).Value
      Case "Terminé"
        Cel.Offset(Dec).EntireRow.Cut Destination:=.Rows(Lig): Lig = 1 + Lig
        Me.Rows(Cel.Offset(Dec).Row).EntireRow.Delete
      Case Empty: Exit Sub
      Case Else: Dec = 1 + Dec
      End Select
    Loop
  End With
  Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowInsertingRows:=True, _
    AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End If
End Sub
_____________________________________________________________________________________________

Sub Protec()
'
' Protec Macro
'

'
    MsgBox "Feuille protégé"
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
_____________________________________________________________________________________________

Sub deprotect()
'
' deprotect Macro
'

'
    MsgBox "Protection désactivé"
    ActiveSheet.Unprotect
End Sub

• Feuil 5 (=( °w° )=_Archive_=( °w° )=)

Private Sub CommandButton1_Click()

End Sub

Modules:

• Module 1

Sub Inserligne()

    ActiveSheet.Unprotect ' enlever la protection
    
    quantite = Application.InputBox("nombre de ligne à inserer", "insertion de ligne", Type:=1) 'Boite de dialogue pour le nb de ligne
    
    ActiveSheet.Range("$B$9:$AI$43").AutoFilter Field:=31, Criteria1:= _
        "A initier" 'Fitre pour enlever les filtres éventuels
    
    ActiveSheet.ShowAllData ' enleve les filtres

    For compteur = 1 To quantite
     
       Range("B10").End(xlDown).Offset(1, 0).Select
       Selection.EntireRow.Insert 'insert une ligne
       ActiveCell.Offset(-1, 0).Select 'va 1 case en dessus
       Range(ActiveCell(1, 1), ActiveCell(1, 34)).Select 'sélection de 34 cellule à droite
       Selection.Copy
       ActiveCell.Offset(1, 0).Select 'va 1 case en dessous
       Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False 'colle le format
       ActiveCell.Offset(0, 10).Select 'déplace 10 cellule à droite
       Application.CutCopyMode = False
            Selection.FillDown ' colle à l'identique du dessus
       ActiveCell.Offset(0, 6).Select 'déplace 6 cellule à droite
       Application.CutCopyMode = False
            Selection.FillDown ' colle à l'identique du dessus
       ActiveCell.Offset(0, 14).Select 'déplace 14 cellule à droite
       Range(ActiveCell(1, 1), ActiveCell(1, 4)).Select 'sélection de 4 cellule à droite
       Application.CutCopyMode = False
            Selection.FillDown ' colle à l'identique du dessus
       ActiveCell.Offset(0, -28).Select 'déplace 28 cellule à gauche
       
     Next
     
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowInsertingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True 'proteger la feuille
        ActiveCell.Offset(0, 0).Select 'déplace 0 cellule à gauche
        
End Sub

________________________________________________________________

Function PremièreCelluleVideSousDernièreCelluleNonVide(r As Range) As Range
'r étant une cellule, la fonction renvoie la Première Cellule Vide Sous la Dernière Cellule NonVide en dessous de r.
    With r.Parent.Cells(r.Parent.Rows.Count, r.Column).End(xlUp).Offset(1)
        Set PremièreCelluleVideSousDernièreCelluleNonVide = .Parent.Cells((.Row + r.Row + Abs(.Row - r.Row)) / 2, r.Column).Offset(IsEmpty(r.Value) * (r.Row = 1) * (.Row = 2))
    End With
End Function

• Module 2

Sub Macro3()
'
' Macro3 Macro
'

'
    ActiveSheet.Range("$B$9:$AI$43").AutoFilter Field:=31, Criteria1:= _
        "A initier"
End Sub

 

[fredd]

Re : Optimisation de macro et correction de MEF conditionnel

Correction apporté:

• Suppression des données dans Feuil 5 (=( °w° )=_Archive_=( °w° )=) "Private Sub CommandButton1_Click()"
• Suppression des données dans le module 2 "macro 3()"
• Remplacement du code

  quantite = Application.InputBox("nombre de ligne à inserer", "insertion de ligne", Type:=1) 'Boite de dialogue pour le nb de ligne

du module 1 par

quantite = Application.InputBox("nombre de ligne à inserer", "insertion de ligne", Default:=1, Type:=1) 'Boite de dialogue pour le nb de ligne

 

[fredd]

Re : Optimisation de macro et correction de MEF conditionnel

Merci, Pierrot93 j'en ai pris note et ça fonctionne.