Simplification macro

Résolu
CyrilD76 Messages postés 3 Statut Membre -  
CyrilD76 Messages postés 3 Statut Membre -
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 ^^

2 réponses

  1.
    jordane45 Messages postés 30426 Date d'inscription   Statut Modérateur Dernière intervention   4 830
     
    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
    1. CyrilD76 Messages postés 3 Statut Membre
       
      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
  2. CyrilD76 Messages postés 3 Statut Membre
     
    Après recherche et test, c'est la ligne ".DisplayAlerts = False" qui faisait planté la macro ...
    Nous sommes en utilisateur et non administrateur.
    0

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro
vincentphilippos -
tontong -

6 réponses
recup couleur de cellule sans macro
magouero -
JvDo -

7 réponses
convertir des chiffres en lettres avec une unique formule
FOUAD_9000 -
Mike-31 -

34 réponses