Simplification macro

Résolu/Fermé
CyrilD76 Messages postés 3 Date d'inscription lundi 10 septembre 2018 Statut Membre Dernière intervention 12 septembre 2018 - Modifié le 10 sept. 2018 à 10:50
CyrilD76 Messages postés 3 Date d'inscription lundi 10 septembre 2018 Statut Membre Dernière intervention 12 septembre 2018 - 12 sept. 2018 à 15:43
Bonjour à tous,

Je travail actuellement sur un fichier pour le travail afin de facilité une partie de mon travail ainsi que celui de mes collègues.

Ce fichier fonctionne actuellement mais il est extrêmement long et ne fonctionne pas sur tous les pc de la société (évidement, nous n'avons pas tous les mêmes ni les mêmes versions d'office).

J'aurais voulu savoir si quelqu'un de Rouen ou alentour pourrait m'aider à le simplifier ?
(je peux toujours l'envoyer mais sans les explications, je doute que cela vous soit utile ...)

Je suis novice, jamais eu de cours sur le sujet ... J'ai appris en lisant les forums et en passant par l'enregistrement de macro... Donc, pour des experts, il doit pas être terrible ...

Merci par avance de votre aide, si c'est possible ^^

A voir également:

2 réponses

jordane45 Messages postés 38430 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 20 février 2025 4 735
Modifié le 10 sept. 2018 à 11:12
Bonjour,


J'aurais voulu savoir si quelqu'un de Rouen ou alentour pourrait m'aider à le simplifier ?

Le principe de ce forum.. c'est de résoudre les soucis... sur le forum.
Pas par mail.. ni skype... ni en se déplaçant.....




(je peux toujours l'envoyer mais sans les explications, je doute que cela vous soit utile ...)

D'où l'interet de :
1 - donner le code concerné (ou le fichier )
2 - Donner toutes les explications utiles.


Pour déposer un fichier : https://www.commentcamarche.net/faq/29493-utiliser-cjoint-pour-heberger-des-fichiers

Pour poster des bouts de code sur le forum : https://codes-sources.commentcamarche.net/faq/11288-poster-un-extrait-de-code


Déjà, pour gagner du temps, si, comme je le pense tu fais des selections de feuilles, cellules.. à tout bout de champ... tu peux déjà :
Désactiver l'affichage des modifications durant l'exécution de la macro
application.screenupdating  = false

Puis la remettre à true à la fin de la macro
application.screenupdating  = true


Eviter les Feuil.Select , Range.Select.....
Sheets("Feuil1").Select
Sheets("Feuil1").Range("A1").Select
Selection.Copy

A la place, tu peux par exemple
Sheets("Feuil1").Range("A1").Copy


Pour le reste... faudra voir ton code.
NB: Si sur certains postes ton code ne fonctionne pas... il doit, lorsque ça bloque, y avoir un message d'erreur et pointer sur une de tes lignes de code...
Il serait bien d'identifier les lignes qui posent problème et nous les coller directement sur le forum en précisant avec quelle version d'excel ça coince.






1
CyrilD76 Messages postés 3 Date d'inscription lundi 10 septembre 2018 Statut Membre Dernière intervention 12 septembre 2018
Modifié le 10 sept. 2018 à 14:24
Merci pour la réponse.

Si j'ai demandé à voir quelqu'un, c'est que mon fichier ne contient pas qu'une macro mais une bonne vingtaine et qu'il est confidentiel ...
Bon, certaines se ressemblent beaucoup.

L'erreur que j'ai le plus souvent, c'est 400 ... J'en ai conclu que cette erreur été pour la puissance du PC après des tests sur d'autres PC.

Sinon, comme je l'ai précisé, c'est plus pour les simplifiées car elles sont assez lourdes et longues.
Diviser en plusieurs sub aiderai ?
J'ai essayé de les simplifier comme tu l'as indiqué mais des erreurs viennent se mettre sur ces simplifications.
Tout fonctionne mais beaucoup trop long :/

Voici un exemple :

Sub MAJ_FORM_TOTO_VOLET3()

If Sheets("FORM_TOTO_VOLET3").Cells(4, 1) <> Empty Then
SUPPRESSION_TTES_IMAGES 'Cf. Module 1 => Suppression de toutes les images
Range("A8:J1007").ClearContents '=> Efface toutes les cotes
FORM_TOTO_VOLET3_V2 '=> Actualisation du volet 3

Else: FORM_TOTO_VOLET3_V2
End If

End Sub

Sub FORM_TOTO_VOLET3_V2()

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With


Dim nf As Integer 'Variable numéro ligne formulaire FAI
Dim nPS As Integer 'Variable numéro ligne Plan de Surveillance
Dim Nbligne As Integer 'Variable calcul du nombre de ligne au total
nf = 7
nPS = 10
Nbligne = Sheets("Listes").Cells(32, 2)


'*************ENTETE*************
Sheets("FORM_TOTO_VOLET3").Cells(4, 1) = Sheets("Plan_surveillance").Cells(5, 58) 'Référence
Sheets("FORM_TOTO_VOLET3").Cells(4, 5) = Sheets("Plan_surveillance").Cells(5, 68) 'Désignation
Sheets("FORM_TOTO_VOLET3").Cells(4, 7) = Sheets("Plan_surveillance").Cells(5, 81) 'N° OF
Sheets("FORM_TOTO_VOLET3").Cells(4, 9) = Sheets("Plan_surveillance").Cells(5, 89) 'N° FAI


'*************Signature & date*************
Dim signataire As String
signataire = Sheets("Listes").Cells(36, 2) 'Nom contrôleur
vérificateur = Sheets("Listes").Cells(41, 2) 'Nom vérificateur KC

'Nom contrôleur
If Sheets("Listes").Cells(40, 2) = 1 Then
Sheets("FORM_TOTO_VOLET3").Cells(1009, 3) = signataire & vbCrLf & vérificateur
Else: Sheets("FORM_TOTO_VOLET3").Cells(1009, 3) = signataire
End If

'Image signature
If Sheets("Listes").Cells(40, 2) = 1 Then
Sheets("Listes").Select
ActiveSheet.Shapes.Range(Array("SIGNATURE_" & signataire)).Select
Selection.Copy
Sheets("FORM_TOTO_VOLET3").Select
Cells(1009, 5).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Listes").Select
ActiveSheet.Shapes.Range(Array("SIGNATURE_" & vérificateur)).Select
Selection.Copy
Sheets("FORM_TOTO_VOLET3").Select
Cells(1009, 6).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else:
Sheets("Listes").Select
ActiveSheet.Shapes.Range(Array("SIGNATURE_" & signataire)).Select
Selection.Copy
Sheets("FORM_TOTO_VOLET3").Select
Cells(1009, 5).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If

'Date contrôle
If Sheets("Listes").Cells(40, 2) = 1 Then
Sheets("FORM_TOTO_VOLET3").Cells(1009, 8) = Sheets("Listes").Cells(37, 2) & vbCrLf & Sheets("Listes").Cells(42, 2)
Else: Sheets("FORM_TOTO_VOLET3").Cells(1009, 8) = Sheets("Listes").Cells(37, 2)
End If

'*************COTES*************
For i = 1 To Nbligne + 1
Sheets("FORM_TOTO_VOLET3").Cells(nf, 1) = Sheets("Plan_surveillance").Cells(nPS, 1) 'N° Cote
Sheets("FORM_TOTO_VOLET3").Cells(nf, 2) = Sheets("Plan_surveillance").Cells(nPS, 3) 'Localisation

'Classification si majeure
If Sheets("Plan_surveillance").Cells(nPS, 5) = "Majeure" Then
Sheets("FORM_TOTO_VOLET3").Cells(nf, 3) = Sheets("Plan_surveillance").Cells(nPS, 5) & vbCrLf & Sheets("Plan_surveillance").Cells(nPS, 7)
'Classification si mineure
Else: Sheets("FORM_TOTO_VOLET3").Cells(nf, 3) = Sheets("Plan_surveillance").Cells(nPS, 5)
End If

'Exigence cotes
If Sheets("Plan_surveillance").Cells(nPS, 10) <> "Aut" And Sheets("Plan_surveillance").Cells(nPS, 10) <> "Tol. Géo" And Sheets("Plan_surveillance").Cells(nPS, 10) <> "Ch" Then 'Exigence complète si non tolérance géométrique
Sheets("FORM_TOTO_VOLET3").Cells(nf, 4) = Sheets("Plan_surveillance").Cells(nPS, 55) & " " & Sheets("Plan_surveillance").Cells(nPS, 56) & Sheets("Plan_surveillance").Cells(nPS, 57) & " " & Sheets("Plan_surveillance").Cells(nPS, 37) 'Exigence complète
Rows(nf).EntireRow.AutoFit
'Exigence complète si Autre
ElseIf Sheets("Plan_surveillance").Cells(nPS, 10) = "Aut" Then
Sheets("FORM_TOTO_VOLET3").Cells(nf, 4) = Sheets("Plan_surveillance").Cells(nPS, 55) & " " & Sheets("Plan_surveillance").Cells(nPS, 56) 'Exigence complète
Rows(nf).EntireRow.AutoFit
'Exigence complète si Ch
ElseIf Sheets("Plan_surveillance").Cells(nPS, 10) = "Ch" Then
Sheets("FORM_TOTO_VOLET3").Cells(nf, 4) = Sheets("Plan_surveillance").Cells(nPS, 55) & " " & Sheets("Plan_surveillance").Cells(nPS, 56) & " " & Sheets("Plan_surveillance").Cells(nPS, 13) & " " & Sheets("Plan_surveillance").Cells(nPS, 53) & " à " & Sheets("Plan_surveillance").Cells(nPS, 15) & "° " & Sheets("Plan_surveillance").Cells(nPS + 1, 53) 'Exigence complète
Rows(nf).EntireRow.AutoFit
'Exigence complète si Tol. Géo (copier/coller)
ElseIf Sheets("Plan_surveillance").Cells(nPS, 10) = "Tol. Géo" Then
Rows(nf).Select
Selection.RowHeight = 31
Sheets("Plan_surveillance").Cells(nPS, 56).Copy
Sheets("FORM_TOTO_VOLET3").Cells(nf, 4).Select
ActiveSheet.Pictures.Paste(Link:=True).Select
Application.CutCopyMode = False

Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.IncrementTop 3.1034645669
Selection.ShapeRange.ScaleHeight 0.9030689663, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 174
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 32
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 0
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = -1
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.IncrementTop 0.00007874015748
Selection.ShapeRange.ScaleHeight 0.8586756716, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 174
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 32
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 0
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 0
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.ScaleWidth 0.897740972, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 174
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 32
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 8
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 0
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.IncrementLeft 6.7240944882
Selection.ShapeRange.ScaleWidth 0.9569534254, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.PictureFormat.Crop.PictureWidth = 174
Selection.ShapeRange.PictureFormat.Crop.PictureHeight = 32
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetX = 5
Selection.ShapeRange.PictureFormat.Crop.PictureOffsetY = 0
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 0.75
End With
Selection.ShapeRange.Height = 25.5118110236
Selection.ShapeRange.Width = 150.2362204724
Selection.Placement = xlMoveAndSize
Selection.Locked = msoFalse

End If

Sheets("FORM_TOTO_VOLET3").Cells(nf, 5) = Sheets("Plan_surveillance").Cells(nPS, 106) 'Résultat
Sheets("FORM_TOTO_VOLET3").Cells(nf, 6) = Sheets("Plan_surveillance").Cells(nPS, 101) 'Outillage

'Relevé si KC
Sheets("FORM_TOTO_VOLET3").Cells(nf, 9) = Sheets("Plan_surveillance").Cells(nPS, 106)


nf = 7 + i
nPS = (10 + (i * 2)) - 2

Next


'*************Ré-écriture de l'entête*************
Sheets("FORM_TOTO_VOLET3").Cells(6, 1) = "5. N° de caractéristique"
Sheets("FORM_TOTO_VOLET3").Cells(6, 2) = "6. Localisation"
Sheets("FORM_TOTO_VOLET3").Cells(6, 3) = "7. Classification de la caractéristique"
Sheets("FORM_TOTO_VOLET3").Cells(6, 4) = "8. Exigence"
Sheets("FORM_TOTO_VOLET3").Cells(6, 5) = "9. Résultats"
Sheets("FORM_TOTO_VOLET3").Cells(6, 6) = "10. Outillage spécifique"
Sheets("FORM_TOTO_VOLET3").Cells(6, 7) = "11. Numéro de non-conformité"
Sheets("FORM_TOTO_VOLET3").Cells(7, 8) = "Moyen Contrôle DVI"
Sheets("FORM_TOTO_VOLET3").Cells(7, 9) = "Relevé DVI"
Sheets("FORM_TOTO_VOLET3").Cells(7, 10) = "Corrélation"


'*************Mise en forme des colonnes*************
Columns("A:J").Select
Range("A6").Activate
Application.CutCopyMode = False
With Selection
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With

With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With

Sheets("FORM_TOTO_VOLET3").Select
Cells(8, 1).Select


End Sub
0
CyrilD76 Messages postés 3 Date d'inscription lundi 10 septembre 2018 Statut Membre Dernière intervention 12 septembre 2018
12 sept. 2018 à 15:43
Après recherche et test, c'est la ligne ".DisplayAlerts = False" qui faisait planté la macro ...
Nous sommes en utilisateur et non administrateur.
0