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

A

Anais0998

XLDnaute Nouveau
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.


1034061






1034062

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
 
Trier par date Trier par votes
A

Anais332*192

XLDnaute Nouveau
Bonjour BrunoM45 et merci beaucoup pour ton aide. On y est presque, il y a juste un petit détail qui ne va pas : tout fonctionne parfaitement dès lors que les 4 questions du thème "santé sécurité" portent sur des pictos, mais dans la réalité, un sujet comporte au maximum 1 seule question picto à la fois, mais qui peut tomber sur n'importe quelle question du thème, soit la question 5 soit la 6 soit la 7 ou soit la 8. Or, après avoir fait plusieurs tests, ça plante dès qu'une des questions ne se rapporte pas à un picto :( je vais tenter de voir d'où ça vient mais vu ton niveau de programmation je doute fort d'être capable de trouver d'où ça vient, mais je vais essayer. Je te remercie encore une fois.
 
Vote positif 0 Vote négatif
J

JM27

XLDnaute Barbatruc
Bonjour
Ton fichier : incompréhensible
mélanger des macros et des formules , ca va mal se passer !!!
tes formules dans la BDD colonnes S : surement des erreurs ( qui ne permettent pas d'afficher les items de la picture 9.
les items des pictures 5,6,8 et 9 ???????)
A toi de voir ( les pictos sont fonctionnels)
 

Pièces jointes

  • Copie de QCM EVALUATION CERTIPHYTO-fichier-test.zip
    969 KB · Affichages: 9
Dernière édition:
Vote positif 0 Vote négatif
A

Anais0998

XLDnaute Nouveau
JM27 à dit:
Bonjour
Ton fichier : incompréhensible
mélanger des macros et des formules , ca va mal se passer !!!
tes formules dans la BDD colonnes S : surement des erreurs ( qui ne permettent pas d'afficher les items de la picture 9.
les items des pictures 5,6,8 et 9 ???????)
A toi de voir ( les pictos sont fonctionnels)
Cliquez pour agrandir...
JM27 à dit:
Bonjour
Ton fichier : incompréhensible
mélanger des macros et des formules , ca va mal se passer !!!
tes formules dans la BDD colonnes S : surement des erreurs ( qui ne permettent pas d'afficher les items de la picture 9.
les items des pictures 5,6,8 et 9 ???????)
A toi de voir ( les pictos sont fonctionnels)
Cliquez pour agrandir...



Bonjour JM27,
La formule dans la colonne S de la bdd sert à compter le nombre de clik, et donc le nombre de questions sélectionnées.

De ce fait, 1 clik affiche 1 dans la colonne s et génère la question n°1 dans la feuille sujet, 2ème clik affiche 2 dans la colonne S, et génère la question 2. 3ème clik affiche 3 et génère la question 3 du sujet, etc.

Sachant qu'il y a 4 questions par thème, les questions "santé et sécurité" sont les questions 5, 6, 7, et 8.

la colonne S indique donc ces numéros de questions, qui sont reportés en colonne A de la bdd afin de permettre une recherccheV dans cette bdd, à partir de la feuille Sujet, et alimenter ainsi toutes les cellules "questions" ainsi que les cellules "propositions de réponse" correspondantes

Il y avait effectivement un soucis de noms d'image pour la 9, comme l'avait indiqué BrunoM45, erreur rectifiée.

Je suis d'accord avec toi, mon fichier c'est du bricolage, malheureusement je fais avec le peu de connaissances que j'ai, mais je demande qu'à apprendre, je ne cherche pas à ce que l'on me fasse tout le boulot, je demande simplement de l'aide pour m'orienter et me guider afin que je trouve des solutions , il n'y a que comme ça que l'on apprend, et c'est ce que je recherche.

Je suis sûre que l'on peut arriver au résultat escompté, mais le niveau est trop haut pour moi du coup je n'arrive pas à finaliser mon fichier.

Mais je suis du genre têtue et je ne lâche pas tant que je n'ai pas le résultat recherché, donc je continue à tester toutes les idées qui me passent par la tête et je cherche des idées en consultant les forums, ça prendra bcp plus de temps sans aide donc je suis toujours preneuse de toutes les idées que vous pourriez me proposer. En tous cas merci bcp de prendre sur votre temps pour m'aider.

Bonne journée à tous
 
Vote positif 0 Vote négatif
C

Compte Supprimé 979

Guest
Salut

Anais332*192 à dit:
Bonjour BrunoM45 et merci beaucoup pour ton aide. On y est presque, il y a juste un petit détail qui ne va pas : tout fonctionne parfaitement dès lors que les 4 questions du thème "santé sécurité" portent sur des pictos, mais dans la réalité, un sujet comporte au maximum 1 seule question picto à la fois, mais qui peut tomber sur n'importe quelle question du thème, soit la question 5 soit la 6 soit la 7 ou soit la 8. Or, après avoir fait plusieurs tests, ça plante dès qu'une des questions ne se rapporte pas à un picto :( je vais tenter de voir d'où ça vient mais vu ton niveau de programmation je doute fort d'être capable de trouver d'où ça vient, mais je vais essayer. Je te remercie encore une fois.
Cliquez pour agrandir...
Peux-tu nous expliquer succinctement comment tu utilises ton fichier pour arriver au bug !?

A+
 
Vote positif 0 Vote négatif
A

Anais332*192

XLDnaute Nouveau
BrunoM45 à dit:
Salut


Peux-tu nous expliquer succinctement comment tu utilises ton fichier pour arriver au bug !?

A+
Cliquez pour agrandir...


Bonsoir BrunoM45,

Le but étant de créer des sujets d'évaluation différents à chaque session, pour commencer, je vais dans ma bdd pour faire la sélection des questions. Je fais un tri par nbre d'utilisation dans la colonne NC3 ou NC4 selon l'évaluation concernée.
Mon fichier complet comporte une page d'accueil, avec des boutons dont un qui s'appelle "nouveau sujet". Un userform avec des listes déroulantes apparaît et là je sélectionne la date, le centre de formation et le type d'évaluation concerné (3 ou 4), chiffre qui se reporte dans la colonne T de la bdd. C'est important car selon le type, il n'y a ni le même nombre ni les mêmes questions (pour le 3 des lignes sont floutées sur certaines questions).

Donc pour en revenir à ta question, lors de la sélection des questions dans la bdd (colonne P, pour commencer je fais RAZ pour effacer les sélections précédentes. ensuite je sélectionne mes questions (double clik dans la colonne P) en tenant compte du nbre de fois déjà utilisé pour chaque question. Il faut 4 questions par thème (colonne E bdd) une alerte msbox apparaît à chaque fois que l'on atteint le quota des 4 questions par thème. Ma colonne A qui bdd sert de critère de recherche pour mes RECHERCHEV placés dans le sujet (colonne B), ce qui reporte donc dans le sujet, mes questions et propositions de réponses sélectionnées dans la bdd. Je sais c'est pas très clair à première vue. Les colonnes N et O de la bdd comptabilisent le nombre de fois que chaque question a déjà été utilisée dans un sujet.

Pour le thème "santé sécurité", les questions concernées sont les questions 5 (A99 du sujet), 6 (A104 du sujet), 7 (A109 du sujet) et 8 (A114 du sujet) et colonne A de la bdd.
Comme je disais plus haut, un sujet d'évaluation ne peut comporter qu'une seule question "picto" à la fois, et selon la sélection faite dans la bdd, ça peut tomber sur la question 5, comme la question 6, 7 ou 8, et ça peut être n'importe quel picto allant du n°1 au n°9, c'est pourquoi mais mon code prévoit que le transfert du picto fonctionne dans n'importe quel cas de figure, il faut que ça fonctionne aussi bien pour les 4 questions et pour les 9 pictos (je e sais pas si je me fais bien comprendre).

Du coup, avec ton code, ça fonctionne parfaitement lorsque la sélection des questions 5 à 8 du sujet porte sur 4 questions "pictos" de la bdd, mais ça ne fonctionne plus si par exemple à la question 5, ou la question 6 ou 7 ou 8 du sujet, tu sélectionnes la question 2-01 ou 2-02 ou 2-03 de la bdd (colonne B bdd), car ce sont bien des questions du thème "santé sécurité" mais qui ne portent pas sur les pictos. Là est le soucis. Un sujet comportera 1 seule question picto de la bdd, qui concernera soit la question 5 soit 6 soit 7 soit 8 (colonne A du sujet) du thème santé sécurité. j'espère que tu comprendras mieux le fonctionnement. Merci encore pour ton aide et passe une bonne soirée.
 
Vote positif 0 Vote négatif
T

ThomasR

XLDnaute Occasionnel
Bonjour,

Je n'ai pas tous regardé car il y a déjà du monde sur ton problème.

Voici mes remarques (conseils) :
Ajout un test pour ta suppression d'image afin que tu puisses avoir l'opportunité de mettre des images à ne pas supprimer
VB: 
'avant
For Each Img In Sheets("SujetNC3").Pictures
    Img.Delete
Next Img
'après
For Each Img In Sheets("SujetNC3").Pictures
    if Img.name like "Picto*" then Img.Delete
Next Img
pour ce faire lors de ta copie impose un nom à ton picto

il faut bannir les "select" :
Code: 
'avant
 Sheets("BddQuestions").Range("N2:N253").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'après
 Sheets("BddQuestions").Range("N2:N253").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Si tu traites des objets communs alors utiliser le "with"
si je reprend l'exemple d'avant
Code: 
'avant
If Range("TypeCertiphyto") = 3 Then
    Sheets("BddQuestions").Range("R2:R253").Select
    Selection.Copy
    Sheets("BddQuestions").Range("N2:N253").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("N1").Select
  Else
  Exit Sub
  End If
  'après
  If Range("TypeCertiphyto") = 3 Then
        with Sheets("BddQuestions")
            .Range("R2:R253").Copy
            .Range("N2:N253").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        end with
  Else
      Exit Sub
  End If

pour finir dans ta fonction test qui n'est pas fonctionnel (je ne l'ai pas testé mais en comparant avec le reste de ton code je me dit que tu as peut être oublié de mettre array()
exemple :
Code: 
'avant
Sub test() 'Non fonctionnelle
Dim x As Long
Dim i As Long
x = 1: i = 1 'Pour l'exemple
With Worksheets("SujetNC4")
oCell = Application.Choose(i, "C99", "C104", "C109", "C114")
x = .Range(oCell).Value
If x >= 1 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
Sheets("ListesEval").Shapes.Range(StrShape).Copy

If x >= 2 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
If x >= 3 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
If x >= 4 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
If x >= 5 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
If x >= 6 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
If x >= 7 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
If x >= 8 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
If x >= 9 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")

With .Range(oCell)
     .EntireRow.RowHeight = 41
     .Offset(0, 1).Paste
     .ShapeRange.IncrementLeft 355.8
     .ShapeRange.IncrementTop 2.4
End With
End With
End Sub
Après
Code: 
Sub test() 'Non fonctionnelle
Dim x As Long
Dim i As Long
x = 1: i = 1 'Pour l'exemple
With Worksheets("SujetNC4")
oCell = Application.Choose(i, "C99", "C104", "C109", "C114")
x = .Range(oCell).Value
If x >= 1 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
Sheets("ListesEval").Shapes.Range(Array(StrShape)).Copy
With .Range(oCell)
     .EntireRow.RowHeight = 41
     .Offset(0, 1).Paste
     .ShapeRange.IncrementLeft 355.8
     .ShapeRange.IncrementTop 2.4
End With
End With
End Sub

Voila pour mes remarques
N'hésite pas si tu as besoin d'aide
 
Vote positif 0 Vote négatif
A

Anais332*192

XLDnaute Nouveau
ThomasR à dit:
Bonjour,

Je n'ai pas tous regardé car il y a déjà du monde sur ton problème.

Voici mes remarques (conseils) :
Ajout un test pour ta suppression d'image afin que tu puisses avoir l'opportunité de mettre des images à ne pas supprimer
VB: 
'avant
For Each Img In Sheets("SujetNC3").Pictures
    Img.Delete
Next Img
'après
For Each Img In Sheets("SujetNC3").Pictures
    if Img.name like "Picto*" then Img.Delete
Next Img
pour ce faire lors de ta copie impose un nom à ton picto

il faut bannir les "select" :
Code: 
'avant
Sheets("BddQuestions").Range("N2:N253").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'après
Sheets("BddQuestions").Range("N2:N253").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Si tu traites des objets communs alors utiliser le "with"
si je reprend l'exemple d'avant
Code: 
'avant
If Range("TypeCertiphyto") = 3 Then
    Sheets("BddQuestions").Range("R2:R253").Select
    Selection.Copy
    Sheets("BddQuestions").Range("N2:N253").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("N1").Select
  Else
  Exit Sub
  End If
  'après
  If Range("TypeCertiphyto") = 3 Then
        with Sheets("BddQuestions")
            .Range("R2:R253").Copy
            .Range("N2:N253").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        end with
  Else
      Exit Sub
  End If

pour finir dans ta fonction test qui n'est pas fonctionnel (je ne l'ai pas testé mais en comparant avec le reste de ton code je me dit que tu as peut être oublié de mettre array()
exemple :
Code: 
'avant
Sub test() 'Non fonctionnelle
Dim x As Long
Dim i As Long
x = 1: i = 1 'Pour l'exemple
With Worksheets("SujetNC4")
oCell = Application.Choose(i, "C99", "C104", "C109", "C114")
x = .Range(oCell).Value
If x >= 1 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
Sheets("ListesEval").Shapes.Range(StrShape).Copy

If x >= 2 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
If x >= 3 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
If x >= 4 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
If x >= 5 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
If x >= 6 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
If x >= 7 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
If x >= 8 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
If x >= 9 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")

With .Range(oCell)
     .EntireRow.RowHeight = 41
     .Offset(0, 1).Paste
     .ShapeRange.IncrementLeft 355.8
     .ShapeRange.IncrementTop 2.4
End With
End With
End Sub
Après
Code: 
Sub test() 'Non fonctionnelle
Dim x As Long
Dim i As Long
x = 1: i = 1 'Pour l'exemple
With Worksheets("SujetNC4")
oCell = Application.Choose(i, "C99", "C104", "C109", "C114")
x = .Range(oCell).Value
If x >= 1 And x <= 9 Then StrShape = Application.Choose(x, "Picture 101", "Picture 102", "Picture 103", "Picture 104", "Picture 105", "Picture 106", "Picture 107", "Picture 108", "Picture 109")
Sheets("ListesEval").Shapes.Range(Array(StrShape)).Copy
With .Range(oCell)
     .EntireRow.RowHeight = 41
     .Offset(0, 1).Paste
     .ShapeRange.IncrementLeft 355.8
     .ShapeRange.IncrementTop 2.4
End With
End With
End Sub

Voila pour mes remarques
N'hésite pas si tu as besoin d'aide
Cliquez pour agrandir...


Bonjour ThomasR,
Je te remercie bcp pour tous ces bons conseils. Je vais prendre le temps de corriger tout ça, car à première vue je n'y comprends pas grand chose, mais en allant doucement je vais y arriver (c'est d'un niveau nettement supérieur au mien). Je te tiens au courant encore merci.
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Bonjour Anais
Bonjour le Fil,le Forum
Pas évident lol
je n'ai pas encore compris la démarche!
Question:
Tu commences par le Choix via le Userform du "TypeCertiphyto"
Ensuite comment procèdes tu ? a partir de Où (quelle Feuille), quelles doivent être les Actions et quel doit être le résultat?
que doit il y avoir dans les cellules ex C66 etc etc ou C99 etc etc Comment arrivent les Numéros , a partir de Quoi ?
merci
jean marie
 
Vote positif 0 Vote négatif
A

Anais332*192

XLDnaute Nouveau
ChTi160 à dit:
Bonjour Anais
Bonjour le Fil,le Forum
Pas évident lol
je n'ai pas encore compris la démarche!
Question:
Tu commences par le Choix via le Userform du "TypeCertiphyto"
Ensuite comment procèdes tu ? a partir de Où (quelle Feuille), quelles doivent être les Actions et quel doit être le résultat?
que doit il y avoir dans les cellules ex C66 etc etc ou C99 etc etc Comment arrivent les Numéros , a partir de Quoi ?
merci
jean marie
Cliquez pour agrandir...



Bonsoir ChTi160, bonsoir à tous,

Je vais commencer par une image explicative puis je répondrai à tes questions plus bas


1034409


Bonjour ChTi160, bonjour à tous,
Ce n’est pas évident non plus pour moi car j’ai été obligée de supprimer bcp de choses sur l’extrait de fichier que j’ai posté afin qu’il « passe ».

1 la sélection du type de certiphyto se fait normalement à partir d’un userform qui s’affiche en sélectionnant un bouton (« nouveau sujet ») dans la page d’accueil. Mais tout ça ne figure pas dans le fichier test posté, il faut du coup aller dans la feuille ListesEval et modifier la cellule B2 manuellement en mettant un 3 ou un 4 à EPREUVE CERTIPHYTO-NC3 OU NC4 selon le code testé. Cette action faite normalement par userform alimente la colonne T de la BddQuestions.

2 il faut se rendre dans la feuille BddQuestions, sélectionner 20 questions (4 par thème) en double cliquant dans la colonne P.
Une des 4 questions sur le thème « santé sécurité » doit porter sur un picto (questions 2-14 à 2-22 colonne B de la BDD Questions). Chaque double clik dans la colonne P alimentera la cellule d’un 1, lequel servira à comptabiliser le nombre de fois que la question a été déjà utilisée (colonne N pour le NC3 et O pour le NC4).

L’action de cliquer dans la colonne P de la BddQuestions sélectionne la question et les 3 propositions de réponses correspondantes (colonnes masquées). Si tu clik en premier dans la cellule P3, P3 affichera 1 et A3=1; ensuite si tu clik dans P10, P10 = 1 et A10 = 2, puis dans P15, P15 = 1 et A15 = 3, ainsi de suite jusqu’à arriver à 20 questions sélectionnées. Les chiffres dans la colonne A de la BddQuestions correspondent aux numéros de questions de la feuille SujetNC3 colonne A, cellules grisées (la cellule A66 de la feuille SujetNC3 correspond à la 1ère question du sujet.
Par exemple, dans la cellule B66 de la feuille SujetNC3, il y a une formule rechercheV qui va rechercher le numéro de question (en colonneA66), dans la colonne A de la BddQuestions, pour récupérer l’intitulé de la question et pareil pour les 3 lignes en dessous qui correspondent aux 3 propositions de réponses.

Dans la cellule C66 il y a une formule qui affiche 1 si la question en B66 correspond au picto 1, 2 si la question correspond au picto 2 et ainsi de suite pour les 9 pictos. Les pictos sont listés dans la feuille ListesEval.

Le but n°1 était de générer un sujet complet dans la feuille Sujet, avec toutes les questions sélectionnées dans la BDD : JUSQUE LA TOUT SE MET EN PLACE GRACE AUX FORMULES DANS LES DIFFERENTES FEUILLES (les questions + les propositions de réponses en A B et C de la feuille sujet).
Le but n° 2 était d’aller dans la feuille ListesEval et faire un copié du picto correspondant à la question picto (par exemple sur l’image la question picto est en numéro 7 et concerne le picto 5) et de le coller au bon emplacement dans la feuille Sujet.
Au début, j’aurai voulu que mon picto soit collé automatiquement à l’activation de ma feuille Sujet. Je n’ai pas réussi à intégrer ça dans mon code qui fonctionne certes mais qui est bcp trop long.
J’ai donc rajouté un bouton sur ma feuille Sujet, qui active le copié collé du picto dans le sujet.
Le soucis, c’est que mon code qui copie et colle les pictos est bcp trop long, et malgré les codes application.screenupdating = false et true, le déroulement de ma macro dure plusieurs secondes et le visuel n’est pas très joli.

C’est la raison pour laquelle je demandais de l’aide pour alléger ce code posté au tout début. Le bonus serait de pouvoir automatiser ce code pour copier-coller les pictos, mais bon, si déjà j’arrive à un visuel plus « propre », je serai contente.

J’espère que c’est plus clair maintenant sinon je reste à disposition, mais de mon côté je continue de tester tout ce que je trouve en espérant obtenir le résultat escompté.
Merci encore à tous pour votre aide.
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Bonjour Anais
Bonjour le Fil ,le Forum
Merci de ces précisions ,qui en appellent d'autres Lol
5 thèmes soit 20 questions :
tu dis :
Une des 4 questions sur le thème « santé sécurité » doit porter sur un picto (questions 2-14 à 2-22 colonne B de la BDD Questions)
Cliquez pour agrandir...
ce n'est pas une au moins ?
tu dis :
Les chiffres dans la colonne A de la BddQuestions correspondent aux numéros de questions de la feuille SujetNC3 colonne A, cellules grisées (la cellule A66 de la feuille SujetNC3 correspond à la 1ère question du sujet.
Cliquez pour agrandir...
je ne comprends pas
cellules grisées (la cellule A66 de la feuille SujetNC3 correspond à la 1ère question du sujet
Cliquez pour agrandir...
doit on commencer less sélections d'un thème par une cellule Grisée?

jean marie
 
Vote positif 0 Vote négatif
A

Anais0998

XLDnaute Nouveau
Bonjour ChTi160, bonjour à tous, regarde et dis moi si tu comprends mieux comme ça. Le fichier test ne contient pas tous les thèmes dans le sujet j'ai été obligée de supprimer pas mal de choses pour le poster. Merci encore pour ton aide.


1034449
1034452





1034453





1034454
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Re
Merci Anais
je comprends de plus en Plus mieux Lol
Si j'ai bien Compris 20 questions par Thème à chaque fois !
Pourquoi ? dans ton exemple
la Cellule A66 du thème "Réglementation" est à 1 puis 2 ,3 etc etc
et la Cellule A99 du thème "Santé et Sécurité" est à 5 puis 6 etc etc
n'est ce pas de 1 à 20 pour chaque thème ?
j'avais aussi posé la question , peut il y avoir plusieurs Picto de sélectionnés ou seulement un ?
Puis à quoi correspondent les Lignes Grisées ?
Tu vas dire il à du mal à comprendre Lol
On va y arriver !
merci
jean marie
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Question
Microsoft 365 Macro qui plante exel
Réponses
1
Affichages
211
mapomme
mapomme
P
  • Question
XL 2016 Affecter à un bouton plusieurs possibilité
Réponses
3
Affichages
327
Eric KERGRESSE
E
chilo27
  • Question
Autres Simplifier une macro
Réponses
1
Affichages
256
fanch55
fanch55
C
  • Question
Microsoft 365 Arret macro si condition est fausse
Réponses
4
Affichages
384
Chounoé
C
M
  • Question
XL 2010 Insérer image dans une zone de texte
2
Réponses
15
Affichages
1 K
patricktoulon
patricktoulon
A
  • Résolu(e)
XL 2013 Utilisation de plusieurs conditions
Réponses
7
Affichages
872
AnjyD
A
M
  • Question
XL 2010 Insérer 3 images
Réponses
11
Affichages
476
madoupa
M
N
  • Question
XL 2021 BESOIN D'aide macro
Réponses
7
Affichages
514
Gégé-45550
Gégé-45550
L
  • Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
594
fanfan38
fanfan38
A
  • Question
Microsoft 365 boucle macro pour importer des données
2
Réponses
16
Affichages
1 K
Arnaud Legay
A

Membres actuellement en ligne

17 membres et 128 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 110
Messages
2 085 388
Membres
102 882
dernier inscrit
Sultan94