XL 2016 Besoin d'aide pour alléger ma macro

Anais0998 · 24 Juin 2019

Bonjour à tous,

J'apprends le VBA "sur le tas" et depuis peu. J'arrive à trouver e adapter les codes dont j'ai besoin, mais ce n'est pas toujours évident.
Actuellement je travaille sur un fichier excel pour générer des sujets d'évaluation pour des centres de formation pour adultes.

Il y a 2 niveaux d'évaluations, 3 et 4, mais une seule base de données où sont regroupées toutes les questions par thème, les réponses, ...

A partir de cette BDD, j'ai une colonne qui me permet, lorsque je clique 2 fois sur les lignes correspondant aux questions, de générer les sujets.

Pour la partie santé et sécurité, certaines questions portent sur des pictogrammes. Je souhaitais pouvoir insérer ces pictos dans le sujet grâce à une méthode événementielle , mais je n'y suis pas arrivée.

A partir de l'enregistreur de macro, j'ai pu mettre en place une macro qui me permet de placer les pictos aux emplacements du sujet correspondants aux questions, que j'active à partir d'un bouton.

Le soucis est que cette macro est très longue, et malgré "application.screenupdating" au début et à la fin de mon code, le déroulement de cette macro est assez longue et disgracieuse.

Pourriez vous m'aider à alléger ce code afin d'avoir un déroulement de macro normal et qui passe inaperçu ?

je vous place ci dessous les captures d'écran de ma feuille "sujet" (SujetNC3) et de ma feuille (ListesEval) où sont stockés mes pictos.
Et je place aussi mon code en plusieurs fois car ça ne passe pas sinon.

Je vous remercie d'avance pour votre aide et je vous souhaite une belle journée.

VB:

Sub Questions_sante_securite()
Application.ScreenUpdating = False

If Range("C99").Value = 1 Then
    Sheets("ListesEval").Select
    ActiveSheet.Shapes.Range(Array("Picture 46")).Select
    Selection.Copy
        Sheets("SujetNC3").Select
        Rows("99:99").Select
        Selection.RowHeight = 41
        Range("B99").Select
        ActiveSheet.Paste
            Selection.ShapeRange.IncrementLeft 355.8
            Selection.ShapeRange.IncrementTop 2.4
    End If
    
    
If Sheets("SujetNC3").Range("C99").Value = 2 Then
    Sheets("ListesEval").Select
    ActiveSheet.Shapes.Range(Array("Picture 44")).Select
    Selection.Copy
        Sheets("SujetNC3").Select
        Rows("99:99").Select
        Selection.RowHeight = 41
        Range("B99").Select
            ActiveSheet.Paste
            Selection.ShapeRange.IncrementLeft 355.8
            Selection.ShapeRange.IncrementTop 2.4
   End If
  
        
If Range("C99").Value = 3 Then
    Sheets("ListesEval").Select
    ActiveSheet.Shapes.Range(Array("Picture 50")).Select
        Selection.Copy
           Sheets("SujetNC3").Select
        Rows("99:99").Select
        Selection.RowHeight = 41
        Range("B99").Select
            ActiveSheet.Paste
            Selection.ShapeRange.IncrementLeft 355.8
            Selection.ShapeRange.IncrementTop 2.4
        
ElseIf Range("C99").Value = 4 Then
    Sheets("ListesEval").Select
    ActiveSheet.Shapes.Range(Array("Picture 17")).Select
        Selection.Copy
           Sheets("SujetNC3").Select
        Rows("99:99").Select
        Selection.RowHeight = 41
        Range("B99").Select
            ActiveSheet.Paste
            Selection.ShapeRange.IncrementLeft 355.8
            Selection.ShapeRange.IncrementTop 2.4

    
ElseIf Range("C99").Value = 5 Then
    Sheets("ListesEval").Select
    ActiveSheet.Shapes.Range(Array("Picture 40")).Select
        Selection.Copy
          Sheets("SujetNC3").Select
        Rows("99:99").Select
        Selection.RowHeight = 41
        Range("B99").Select
            ActiveSheet.Paste
            Selection.ShapeRange.IncrementLeft 355.8
            Selection.ShapeRange.IncrementTop 2.4
            
    
ElseIf Range("C99").Value = 6 Then
    Sheets("ListesEval").Select
    ActiveSheet.Shapes.Range(Array("Picture 39")).Select
        Selection.Copy
            Sheets("SujetNC3").Select
        Rows("99:99").Select
        Selection.RowHeight = 41
        Range("B99").Select
            ActiveSheet.Paste
            Selection.ShapeRange.IncrementLeft 355.8
            Selection.ShapeRange.IncrementTop 2.4
      
    
ElseIf Range("C99").Value = 7 Then
    Sheets("ListesEval").Select
    ActiveSheet.Shapes.Range(Array("Picture 42")).Select
    Selection.Copy
            Sheets("SujetNC3").Select
        Rows("99:99").Select
        Selection.RowHeight = 41
        Range("B99").Select
            ActiveSheet.Paste
            Selection.ShapeRange.IncrementLeft 355.8
            Selection.ShapeRange.IncrementTop 2.4
        
    
ElseIf Range("C99").Value = 8 Then
    Sheets("ListesEval").Select
    ActiveSheet.Shapes.Range(Array("Picture 10")).Select
    Selection.Copy
           Sheets("SujetNC3").Select
        Rows("99:99").Select
        Selection.RowHeight = 41
        Range("B99").Select
            ActiveSheet.Paste
            Selection.ShapeRange.IncrementLeft 355.8
            Selection.ShapeRange.IncrementTop 2.4
        
    
ElseIf Range("C99").Value = 9 Then
    Sheets("ListesEval").Select
    ActiveSheet.Shapes.Range(Array("Picture 48")).Select
    Selection.Copy
           Sheets("SujetNC3").Select
        Rows("99:99").Select
        Selection.RowHeight = 41
        Range("B99").Select
            ActiveSheet.Paste
            Selection.ShapeRange.IncrementLeft 355.8
            Selection.ShapeRange.IncrementTop 2.4

    End If

If Range("C104").Value = 1 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 46")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("104:104").Select
Selection.RowHeight = 41
Range("B104").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Sheets("SujetNC3").Range("C104").Value = 2 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 44")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("104:104").Select
Selection.RowHeight = 41
Range("B104").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C104").Value = 3 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 50")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("104:104").Select
Selection.RowHeight = 41
Range("B104").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C104").Value = 4 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 17")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("104:104").Select
Selection.RowHeight = 41
Range("B104").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C104").Value = 5 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 40")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("104:104").Select
Selection.RowHeight = 41
Range("B104").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C104").Value = 6 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 39")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("104:104").Select
Selection.RowHeight = 41
Range("B104").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C104").Value = 7 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 42")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("104:104").Select
Selection.RowHeight = 41
Range("B104").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C104").Value = 8 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 10")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("104:104").Select
Selection.RowHeight = 41
Range("B104").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C104").Value = 9 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 48")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("104:104").Select
Selection.RowHeight = 41
Range("B104").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

End If

If Range("C109").Value = 1 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 46")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("109:109").Select
Selection.RowHeight = 41
Range("B109").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Sheets("SujetNC3").Range("C109").Value = 2 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 44")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("109:109").Select
Selection.RowHeight = 41
Range("B109").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C109").Value = 3 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 50")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("109:109").Select
Selection.RowHeight = 41
Range("B109").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C109").Value = 4 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 17")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("109:109").Select
Selection.RowHeight = 41
Range("B109").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C109").Value = 5 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 40")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("109:109").Select
Selection.RowHeight = 41
Range("B109").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C109").Value = 6 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 39")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("109:109").Select
Selection.RowHeight = 41
Range("B109").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C109").Value = 7 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 42")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("109:109").Select
Selection.RowHeight = 41
Range("B109").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C109").Value = 8 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 10")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("109:109").Select
Selection.RowHeight = 41
Range("B109").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C109").Value = 9 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 48")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("109:109").Select
Selection.RowHeight = 41
Range("B109").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4
End If

If Range("C114").Value = 1 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 46")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("114:114").Select
Selection.RowHeight = 41
Range("B114").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Sheets("SujetNC3").Range("C114").Value = 2 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 44")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("114:114").Select
Selection.RowHeight = 41
Range("B114").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C114").Value = 3 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 50")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("114:114").Select
Selection.RowHeight = 41
Range("B114").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C114").Value = 4 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 17")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("114:114").Select
Selection.RowHeight = 41
Range("B114").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C114").Value = 5 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 40")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("114:114").Select
Selection.RowHeight = 41
Range("B114").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C114").Value = 6 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 39")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("114:114").Select
Selection.RowHeight = 41
Range("B114").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C114").Value = 7 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 42")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("114:114").Select
Selection.RowHeight = 41
Range("B114").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C114").Value = 8 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 10")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("114:114").Select
Selection.RowHeight = 41
Range("B114").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4

ElseIf Range("C114").Value = 9 Then
Sheets("ListesEval").Select
ActiveSheet.Shapes.Range(Array("Picture 48")).Select
Selection.Copy
Sheets("SujetNC3").Select
Rows("114:114").Select
Selection.RowHeight = 41
Range("B114").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 355.8
Selection.ShapeRange.IncrementTop 2.4
End If

Sheets("SujetNC3").Select
Application.ScreenUpdating = True

End Sub

Anais0998 · 1 Juillet 2019

ChTi160 à dit:
Re
une version (perfectible)!
Ou j'ai travaillé , sur le transfert des Shapes "Picto_#"
j'ai changé pas mal de Choses (formules ,références etc )
Enfin tu regardes , et tu me dis .
j'ai Zippé (compressé) le Fichier, supprimé une feuille , pour que cela passe Lol
jean marie

Anais0998 · 1 Juillet 2019

Bonjour ChTi, bonjour à tous,

Je te remercie pour ton aide, je vais regarder la nouvelle version que tu as posté et je te tiens au courant, merci bcp encore.

Sinon, j'ai mis en place un système de floutage des lignes et colonnes selon que l'on sélectionne le NC3 ou le NC4, et le bouton de la colonne floutée est masqué.

Je pensais en avoir bientôt fini (me restait plus qu'à faire la macro d'impression, qui va me poser encore problème car je dois allier des feuilles d'un autre fichier, mais bon on verra) mais on me demande de créer une alerte dans la base de données permettant de bloquer la sélection à 4 questions par thème, c.a.d que si par mégarde je sélectionnais une question de trop dans un des thèmes, le mécanisme bloquerait et je n'aurais pas d'autre choix que de passer au thème suivant, je ne sais pas si je me fais bien comprendre.

Toujours est-il que je vais potasser là dessus mais j'ai pas trop d'idée du comment faire, c'est pas grave je vais encore tester tout ce que je vais trouver.

Sur ce, je vous souhaite à tous un très bon début de semaine, en vous remerciant encore pour tous vos conseils et toutes vos propositions.

ChTi160 · 1 Juillet 2019

Bonsour Anais
je regarfe ce que je oeux faire avec tout ca lol
jean marie

Anais0998 · 3 Juillet 2019

ChTi160 à dit:
Re
une version (perfectible)!
Ou j'ai travaillé , sur le transfert des Shapes "Picto_#"
j'ai changé pas mal de Choses (formules ,références etc )
Enfin tu regardes , et tu me dis .
j'ai Zippé (compressé) le Fichier, supprimé une feuille , pour que cela passe Lol
jean marie

Anais0998 · 3 Juillet 2019

Bonjour ChTi10, bonjour à tous,
Ta version fonctionne super, le soucis, c'est que je ne comprends pas ce que tu as fait, par rapport aux codes, du coup je n'arrive pas à adapter à mon fichier global qui a depuis bcp évolué avec bcp de nouveaux codes, je suis larguée lol. Bon je vais bien finir par y arriver, il le faut car le résultat est vraiment ce que je voulais depuis le départ.
De mon côté j'ai réussi à générer automatiquement les pdf du sujet la feuille correction les étiquettes la feuille à coller sur l'enveloppe qui contiendra les sujets. Là je bosse sur un code pour compiler pdf impression des différents documents.
Par contre j'aurais vraiment besoin que quelqu'un contrôle mes codes quand j'aurais fini, parce que je sais qu'un code peut fonctionner pendant un temps puis d'un coup tout part en cacahuètes et ça ne fonctionne plus, et ça je ne peux pas me le permettre.
Sur ce au boulot, je souhaite à tous une belle journée.

ChTi160 · 3 Juillet 2019

Bonjour Anais
Bonjour le Fil, le Forum
je ne sais comment faire pour t aider.
je peux mettre des commentaires dans le code.
peux tu mettre le fichier ou alors me l envoyer.
leretraite.sncf@gmail.com
avec explications?
dis moi！
jean marie

Anais0998 · 3 Juillet 2019

ChTi160 à dit:
Bonjour Anais
Bonjour le Fil, le Forum
je ne sais comment faire pour t aider.
je peux mettre des commentaires dans le code.
peux tu mettre le fichier ou alors me l envoyer.
leretraite.sncf@gmail.com
avec explications?
dis moi！
jean marie

Anais0998 · 3 Juillet 2019

Bonjour ChTi10, bonjour à tous,

Ecoute, j'y vais code par code, il y a du ménage à faire dans mon fichier, j'ai tellement croisé les codes qu'il faut y aller doucement, mais là, je viens de réussir la manoeuvre principale du transfert du picto .... Youpiiii c'est magique franchement merci bcp ça fait vraiment plus propre on ne voit plus le déroulement de la macro, trop bien, merci encore pour ce travail. Du coup je continue,car je dois faire la même chose pour le sujet nc4 à chaque fois, et je t'enverrai le fichier global quand j'aurai tout mis au point, si tu le veux bien, pour vérifier tout mon mic mac de codes lol. Merci encore

Anais0998 · 3 Juillet 2019

ChTi160 à dit:
Bonjour Anais
Bonjour le Fil, le Forum
je ne sais comment faire pour t aider.
je peux mettre des commentaires dans le code.
peux tu mettre le fichier ou alors me l envoyer.
leretraite.sncf@gmail.com
avec explications?
dis moi！
jean marie

Anais0998 · 3 Juillet 2019

ChTi10 ... au secours .... je suis bloquée j'ai une erreur que je n'arrive pas à résoudre.
Je mets les captures d'écran en espérant que tu pourras me guider.
Merci d'avance

ChTi160 · 3 Juillet 2019

Re
les images（Shapes） ont pour nom “Picto_1” a “Picto_9”
peut etre la raison ！
pas evident sans fichier ！
jean marie

Anais0998 · 3 Juillet 2019

ChTi160 à dit:
Re
les images（Shapes） ont pour nom “Picto_1” a “Picto_9”
peut etre la raison ！
pas evident sans fichier ！
jean marie

Anais0998 · 3 Juillet 2019

ChTi je vais t'envoyer le fichier, j'y arrive pas, mecri d'avance pour ton aide

Effectuez une recherche sur Excel Downloads...

XL 2016 Besoin d'aide pour alléger ma macro

Anais0998

XLDnaute Nouveau

Anais0998

XLDnaute Nouveau

Anais0998

XLDnaute Nouveau

ChTi160

XLDnaute Barbatruc

Anais0998

XLDnaute Nouveau

Anais0998

XLDnaute Nouveau

ChTi160

XLDnaute Barbatruc

Anais0998

XLDnaute Nouveau

Anais0998

XLDnaute Nouveau

Anais0998

XLDnaute Nouveau

Anais0998

XLDnaute Nouveau

ChTi160

XLDnaute Barbatruc

Anais0998

XLDnaute Nouveau

Anais0998

XLDnaute Nouveau

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums