Simplification macro

Résolu

CyrilD76 Messages postés 3 Date d'inscription Statut Membre Dernière intervention -
CyrilD76 Messages postés 3 Date d'inscription Statut Membre Dernière intervention - 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:

Activesheet.pictures.paste
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Jitbit macro recorder - Télécharger - Confidentialité
Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Macro maker - Télécharger - Divers Utilitaires
Macro word - Guide

2 réponses

Réponse 1 / 2

jordane45 Messages postés 38486 Date d'inscription Statut Modérateur Dernière intervention 4 752

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.

CyrilD76 Messages postés 3 Date d'inscription Statut Membre Dernière intervention

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

Réponse 2 / 2

CyrilD76 Messages postés 3 Date d'inscription Statut Membre Dernière intervention

Après recherche et test, c'est la ligne ".DisplayAlerts = False" qui faisait planté la macro ...
Nous sommes en utilisateur et non administrateur.

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro

recup couleur de cellule sans macro

EXCEL transformer chiffres en lettre -facture

convertir des chiffres en lettres avec une unique formule

Votre réponse

Discussions similaires