Optimiser un code

piga25 · 14 Septembre 2011

Bonjour,
J'ai une application comprenant plusieurs onglets dont 5 reçoivent la même info mais que sur 3 colonnes le reste est propre à chaque onglet.
Le code ci-dessous me permet d'ajouter une ligne à un endroit donné et de copier puis de coller une ligne masquée. Cette ligne contient toutes les formules.

Ma question, est il possible de rendre ce code plus concis. et comment? Ce qui me permettra de le faire sur d'autres code du même style.
J'ai une contrainte, il faut obligatoirement que la feuille "planning" soit en mode calcul manuel constament et cela pour des raisons de lenteur. Je force le calcul sur cette feuille uniquement à la demande.

VB:

Sub NouveauIntervenant()
Application.Calculation = xlManual
   Application.ScreenUpdating = False
   Macro1
   Macro2
   Macro3
   Macro4
   Macro5
   Application.ScreenUpdating = True
'Application.Calculation = xlSemiautomatic
End Sub
'---------------------------------------------------
Sub Macro1()
   'sheets("Intervenant").select
   ActiveSheet.Unprotect
   Rows("13:15").EntireRow.Hidden = False
   Rows("14:14").Copy
   Range("InsertInter").Select
   Selection.Insert Shift:=xlDown
   Application.CutCopyMode = False
   Rows("14:14").EntireRow.Hidden = True
   ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
'------------------------------------------------
Sub Macro2()
   Sheets("Gestion intervenants").Select
   ActiveSheet.Unprotect
   Rows("13:15").Select
   Range("D13").Activate
   Selection.EntireRow.Hidden = False
   Rows("14:14").Copy
   Range("InsertGestInter").Insert Shift:=xlDown
   Application.CutCopyMode = False
   Rows("14:14").EntireRow.Hidden = True
   ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
' ---------------------------------------------------
Sub Macro3()
   Sheets("CR Financier").Select
   ActiveSheet.Unprotect
   Rows("4:6").EntireRow.Hidden = False
   Rows("5:5").Copy
   Range("InsertCR").Insert Shift:=xlDown
   Application.CutCopyMode = False
   Rows("5:5").EntireRow.Hidden = True
   ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
'------------------------------------------------------
Sub Macro4()
   Sheets("Planning").Select
   ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
   Range("H6").Select
   ActiveSheet.Unprotect
   Rows("4:6").EntireRow.Hidden = False
   Rows("5:5").Copy
   Range("InsertPlan").Insert Shift:=xlDown
   Application.CutCopyMode = False
   Rows("5:5").EntireRow.Hidden = True
   ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Sub Macro5()
   Sheets("Itineraire").Select
   ActiveSheet.Unprotect
    Rows("13:15").Select
    Range("A15").Activate
    Selection.EntireRow.Hidden = False
    Rows("14:14").Select
    Selection.Copy
    Range("insertitineraire").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    Rows("14:14").Select
    Selection.EntireRow.Hidden = True
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("Intervenants").Select
End Sub

Le lien pour le fichier : Fichier

Merci

mth · 14 Septembre 2011

Re : Optimiser un code

Bonjour,

Pas réussi à faire fonctionner le lien vers le fichier ...

Il doit y avoir mieux mais peut-être avec une seule macro :

Code:

Sub Macro1()
Application.Calculation = xlManual
Application.ScreenUpdating = False
With Sheets("intervenant")
    .Range("InsertInter").Insert Shift:=xlDown
    .Rows("14:14").Copy .Range("InsertInter")
End With
With Sheets("Gestion Intervenants")
'...
End With
'idem autres onglets
Application.ScreenUpdating = True
Application.Calculation = xlSemiautomatic
End Sub

en ajoutant ceci:

Code:

Private Sub Workbook_Open()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
    sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, userinterfaceonly:=True
Next sh
End Sub

Pas pu tester donc sous toute réserve ... 🙂

Bien à toi,

mth

Efgé · 14 Septembre 2011

Re : Optimiser un code

Bonjour piga25, Bonjour mth 🙂,
Un peu comme mth, sans exemple pour tester, je propose ceci:
La macro principale:

VB:

Sub toto()
Dim Liste_feuilles(), Liste_lignes_groupe(), Liste_ligne(), Liste_Range()
Dim i&
Liste_feuilles = Array("Intervenant", "Gestion intervenants", "CR Financier", "Planning", "Itineraire")
Liste_lignes_groupe = Array("13:15", "13:15", "4:6", "4:6", "13:15")
Liste_ligne = Array(14, 14, 5, 5, 14)
Liste_Range = Array("InsertInter", "InsertGestInter", "InsertCR", "InsertPlan", "insertitineraire")
For i = LBound(Liste_feuilles) To UBound(Liste_feuilles)
    Repet Liste_feuilles(i), Liste_lignes_groupe(i), Liste_ligne(i), Liste_Range(i)
Next i
End Sub

et une routine:

VB:

Sub Repet(ByVal Sh As String, ByVal Rws As String, ByVal Rw As Long, ByVal Rng As String)
With Sheets(Sh)
    .Unprotect
    .Rows(Rws).Hidden = False
    .Rows(Rw).Copy
    .Range(Rng).Insert Shift:=xlDown
    .Rows(Rw).Hidden = True
    .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End Sub

A tester sur le vrai fichier....
Cordialement

piga25 · 14 Septembre 2011

Re : Optimiser un code

bonjour mth et Efgé,

Déjà merci pour vos réponses. Je teste cela.

Le lien du fichier est sous ci-joint. J'ai testé celui-ci sur mon post et il fonctionne. C'est un fichier xlsm. Me demander s'il le faut sous 2003.

piga25 · 14 Septembre 2011

Re : Optimiser un code

Re

Mth :
Cela bug au second with dans la 2ème ligne : .Range("InsertGesInter").Insert Shift:=xlDown
cela le fait également si j'interverti les with

Efgé:
De même un bug dans la routine : Sub Repet .........
j'ai une erreure dans la 2eme ligne : With Sheets (sh).

Cette routine se met bien dans le même module que la macro toto.

Merci à vous.

Efgé · 14 Septembre 2011

Re : Optimiser un code

Re
Pour le fichier : le lien arrive sur la page d'accueil de ci-joint, pas sur l"adresse du dépôt.
Si tu peux mettre un fichier allégé et en xls sur le forum ce serai mieux.
Pour le plantage, vérifie que les onglets de ton classeur sont bien nommés comme dans la liste
"Liste_feuilles ". J'ai fait un classeur test, que je n'ai pas avec moi, mais qui ne présentai pas de plantage.
A te re lire (peut être pas ce soir, mais demain je repasserai)

Cordialement

EDIT
La routine se met dans un module standard, le même que la macro principale, ou dans un autre

Yaloo · 14 Septembre 2011

Re : Optimiser un code

Bonjour à tous,

Voici le fichier en xls zippé ici

A+

Efgé · 14 Septembre 2011

Re : Optimiser un code

Re à tous, Bonsoir Yaloo et merci pour le fichier 🙂,
Joli fichier en tous cas. J'aime bien.
Pour le plantage:
Ta feuille se nomme Intervenants et non Intervenant....
Testé sur le fichier donné par Yaloo, sans plantage.
Cordialement

Compte Supprimé 979 · 14 Septembre 2011

Re : Optimiser un code

Bonjour le fil

Juste pour dire à Piga25 qu'il à fait un TRES JOLI boulot ...

De belles couleurs, de beaux icônes ... chapeau bas m'sieur

Au plaisir

piga25 · 14 Septembre 2011

Re : Optimiser un code

Re

Efgé:🙂
C'est tout bon. J'aurai du trouver l'erreur.
J'ai juste ajouter au code :

Code:

  Application.ScreenUpdating = False
  Application.Calculation = xlManual
  ...
  Application.ScreenUpdating = False

Afin de ne pas voir l'écran sauté et le calcul manuel pour que cela aille plus vite.
Merci.

Mth: 🙂
Je garde ton code sous le coude.
Merci

Yaloo:🙂
Merci pour le zip du fichier. Je ne sais pas ce qui se passe avec Ci-joint je n'ai plus accès à mon compte et j'ai une page d'accueil noir.

Merci pour le relais.

BrunoM45:🙂
Merci du compliment.

Mon but avec cette application, c'est de la rendre la plus fonctionnelle possible.
Au cours du weekend du 10 au 11, nous avons réalisé un excercice secours spéléo et avec cette appli nous avons pu tous gérer. Mais il y a encore beaucoup de possibilité pour l'améliorer.
Avis aux amateurs, ils seront les bien venus.
Mon gros problème est les temps de calcul dans l'onglet planning. Je ne sais pas s'il faut que je créé des tables afin de faire calcul auto sauf les tables.😕

Optimiser un code

piga25

XLDnaute Barbatruc

mth

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

piga25

XLDnaute Barbatruc

piga25

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

Yaloo

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

Compte Supprimé 979

Guest

piga25

XLDnaute Barbatruc

Discussions similaires

Optimiser un code

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Compte Supprimé 979

Guest

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency