Menu

Simplification macro [Résolu]

Messages postés
3
Date d'inscription
lundi 10 septembre 2018
Dernière intervention
12 septembre 2018
- 10 sept. 2018 à 10:46 - Dernière réponse :
Messages postés
3
Date d'inscription
lundi 10 septembre 2018
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 ^^

Afficher la suite 

Votre réponse

3 réponses

Meilleure réponse
Messages postés
23246
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
15 novembre 2018
- Modifié par jordane45 le 10/09/2018 à 11:12
1
Merci
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 : http://www.commentcamarche.net/faq/29493-utiliser-cjoint

Pour poster des bouts de code sur le forum : https://codes-sources.commentcamarche.net/faq/11288-les-balises-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.






Cordialement, 
Jordane                                                                 

Merci jordane45 1

Avec quelques mots c'est encore mieux Ajouter un commentaire

CCM a aidé 27991 internautes ce mois-ci

Messages postés
3
Date d'inscription
lundi 10 septembre 2018
Dernière intervention
12 septembre 2018
- 10 sept. 2018 à 14:23
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
Commenter la réponse de jordane45
Messages postés
3
Date d'inscription
lundi 10 septembre 2018
Dernière intervention
12 septembre 2018
- 12 sept. 2018 à 15:43
0
Merci
Après recherche et test, c'est la ligne ".DisplayAlerts = False" qui faisait planté la macro ...
Nous sommes en utilisateur et non administrateur.
Commenter la réponse de CyrilD76