Utilisation de procédures en VBA

Bonjour, Bonjour à tous, et un grand merci d'avance à qui pourra m'aider. Je débute en VBA et apprend tout sur le tas au fur et à mesure...

J'ai récupéré le programme en VBA d'un prédécesseur pour la gestion de production d'un atelier, et je désire y ajouter la gestion de ma partie d'atelier.

J'ai donc repris son codage et l'ai adapté à mes besoins. Sa partie récupérait dans un fichier les données entrées, et les analysait, etc... A la fin de son analyse, j'ai donc appelé ma procédure qui débute ma partie d'analyse, en reprenant les mêmes étapes.

L'ensemble fonctionne, cependant la procédure de copie des temps problèmes (voir la fin du code en annexe) me copie à de nombreuses reprises les problèmes consignés dans un tableau croisé dynamique (j'ai une catégorie "attente pont" qui correspond à 100 minutes de non production, et elle se recopie plusieurs fois au lieu d'une seule).

J'espère que quelqu'un pourra répondre à ma question et que j'ai été assez clair dans mes explications.

Merci!

Jeff!




'III) ouverture "analyse fiche de production"
'_______________________________________________________________________________________________
On Error GoTo padouverture
path = ActiveWorkbook.path & "\"
Workbooks.Open (path + "analyse fiche de production.xlsm")
Sheets("Suivi de retour").Select
Windows("bouclage").Activate

path = ActiveWorkbook.path & "\"
Workbooks.Open (path + "analyse fiche de production épreuves.xlsm")
Sheets("Suivi de retour").Select
Windows("bouclage").Activate
Exit Sub

padouverture: Application.ScreenUpdating = True
End Sub

Sub calcul_chaudronnerie()
Application.ScreenUpdating = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' renseigne les données sur les temps de chaudronnerie
'

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error GoTo ErrorHandler

' copie temps de production chaudronnerie
Dim ligne As Integer
Dim p As Integer
Dim tps_tot_chaud As Double

Sheets("M.E.P").Select
ligne = Range("A65536").End(xlUp).Row + 1

For i = 5 To ligne
p = i + 14
If Sheets("interface").Range("L" & p) = "Chaudronnerie" Then
tps_tot_chaud = tps_tot_chaud + Range("G" & i)
End If
Next i

Sheets("Interface").Select
Range("tps_prod_chaud") = tps_tot_chaud - Range("tps_tot_déplacé")



' Ouverture et traitement d'analyse des fiches de prod chaudronnerie
On Error GoTo ErrorHandler1
Windows("Analyse fiche de production.xlsm").Activate
Sheets("Analyse des problèmes").Select

On Error GoTo ErrorHandler
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 467.25, 60.75, 91.5, 42.75). _
Select
Selection.Name = "Rectangle 1"
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
"Exporter pertes de temps chaudronnerie"
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 29). _
ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignLeft
End With
Selection.ShapeRange.ScaleWidth 1.106557377, msoFalse, msoScaleFromTopLeft
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 29).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
Selection.OnAction = "Bouclage.xlsm!Export_pbs"
Range("A1").Select

ErrorHandler1:
MsgBox ("Veuillez ouvrir le fichier Analyse de Production")
Exit Sub

ErrorHandler:
MsgBox ("Erreur : recommencer tout le processus")

End Sub

Sub Export_pbs()
Application.ScreenUpdating = False

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Exporte les temps perdus en chaudronnerie
'

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ligne As Integer
Windows("Analyse fiche de production.xlsm").Activate
Sheets("Analyse des problèmes").Select

'Effacage bouton de commande
ActiveSheet.Shapes.Range(Array("rectangle 1")).Select
Selection.Delete

'copie des problèmes
ligne = Range("A65536").End(xlUp).Row - 1
Range("A5:B" & ligne).Select
Selection.Copy
Windows("Bouclage.xlsm").Activate
Range("type_problèmes_chaud").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'report du temps méthodes
Windows("Analyse fiche de production.xlsm").Activate
Sheets("BDD par chaudière").Select
ligne = Range("A65536").End(xlUp).Row
tps_tot_chaud = Range("G" & ligne)
Windows("Bouclage.xlsm").Activate
Sheets("Interface").Select
Range("tps_meth_chaud") = tps_tot_chaud + Range("tps_meth_supp_chaud")
calcul_epr
Application.ScreenUpdating = True
End Sub


'Ouverture et traitement de Analyse fiche de production épreuves
Sub calcul_epr()
Application.ScreenUpdating = False


On Error GoTo ErrorHandler2
Windows("Analyse fiche de production épreuves.xlsm").Activate
Sheets("Analyse des problèmes épreuves").Select

On Error GoTo ErrorHandler
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 467.25, 60.75, 91.5, 42.75). _
Select
Selection.Name = "Rectangle 2"
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
"Exporter pertes de temps Equipements/Epreuves"
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 29). _
ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignLeft
End With
Selection.ShapeRange.ScaleWidth 1.106557377, msoFalse, msoScaleFromTopLeft
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 29).Font
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Fill.Solid
.Size = 11
.Name = "+mn-lt"
End With
Selection.OnAction = "Bouclage.xlsm!Export_pbs_eq_epr"
Range("A1").Select

ErrorHandler2:
MsgBox ("Veuillez ouvrir le fichier Analyse de Production")
Exit Sub

ErrorHandler:
MsgBox ("Erreur : recommencer tout le processus")

End Sub

Sub Export_pbs_eq_epr()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Exporte les temps perdus en épreuves
'

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Application.ScreenUpdating = False

Dim ligne As Integer
Windows("Analyse fiche de production épreuves.xlsm").Activate
Sheets("Analyse des problèmes épreuves").Select

'Effacage bouton de commande
ActiveSheet.Shapes.Range(Array("rectangle 2")).Select
Selection.Delete

'copie des problèmes épreuves
ligne = Range("A65536").End(xlUp).Row - 1
Range("A5:B" & ligne).Select
Selection.Copy
Windows("Bouclage.xlsm").Activate
Range("type_problèmes_eq_epr").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'report du temps méthodes
Windows("Analyse fiche de production épreuves.xlsm").Activate
Sheets("BDD par chaudière").Select
ligne = Range("A65536").End(xlUp).Row
tps_tot_eq_epr = Range("H" & ligne)
Windows("Bouclage.xlsm").Activate
Sheets("Interface").Select
Range("tps_meth_eq_epr") = tps_tot_eq_epr + Range("tps_meth_supp_eq_epr")
update_indicateur
Application.ScreenUpdating = True
End Sub

Sub update_indicateur()
Application.ScreenUpdating = False