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

Anais0998

XLDnaute Nouveau
ChTi160 à dit:
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
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
A

Anais0998

XLDnaute Nouveau
Re ChTi160,

Il y a 2 types d'examen : le certiphyto niveau 3 et le certiphyto niveau 4. Dans le fichier je n'ai conservé que le sujet nc3, qui compte donc 20 questions thématiques, soit 4 questions par thème, et 24 questions thématiques, soit 24 questions pour le certiphyto NC4.

Ici nous parlons du sujet NC3. Le fichier test que j'ai posté ne comporte que les 2 premiers thèmes, je pense que c'est ça qui porte à confusion. J'ai du supprimer la suite du sujet pour alléger le fichier.

Les lignes grisées dans la bddQuestions apparaissent que lorsque le certiphyto NC3 est sélectionné, car ce sont des questions qui ne concernent que le certiphyto NC4, qui est d'un niveau supérieur.


Il ne peut y avoir qu'une seule question par sujet sur les picto, et cette question sera toujours positionnée sur l'une des 4 questions du thème "santé sécurité", selon son ordre de sélection dans la bdd.

Je te poste un sujet complet ça t'aidera peut-être à comprendre.
Merci encore.
 

Pièces jointes

  • QCM EVALUATION CERTIPHYTO-fichier-testSUJET.xlsm
    54.7 KB · Affichages: 5
Vote positif 0 Vote négatif
A

Anais0998

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...
 
Vote positif 0 Vote négatif
A

Anais0998

XLDnaute Nouveau
Bonjour ThomasR,

Concernant ton conseil sur le code suivant :

Si tu traites des objets communs alors utiliser le "with"
si je reprend l'exemple d'avant
Code:Copier dans le presse-papier
'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


J'ai un soucis : lorsque je rajoute une ligne (nouvelle question) à la BDD, celle ci n'est pas prise en compte dans le code.
Je cherche un moyen de rendre ce code dynamique mais je n'y arrive pas.
Aurais tu une idée pour m'orienter ?
j'ai essayé avec une variable allant jusqu'aux dernières cellules non vides des deux colonnes pour faire le copié/collé, mais ça fonctionne pas grrrr
Merci d'avance pour tes conseils
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Bonjour Anais
Bonjour le Fil(Thomas) , le Forum
peut être ainsi
VB: 
 'après
If Range("TypeCertiphyto") = 3 Then
With Sheets("BddQuestions")
DerLgn = .Cells(.Rows.Count, 2).End(xlUp).Row 'détermine la dernière ligne Non Vide de la deuxième Colonne
                .Range("R2:R" & DerLgn).Copy 'On copie la palge ainsi définie
               .Range("N2:N" & DerLgn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                  :=False, Transpose:=False 'Et on la colle dans la plage 
Application.CutCopyMode = False
End With
Else
Exit Sub
End If
jean marie
 
Vote positif 0 Vote négatif
A

Anais0998

XLDnaute Nouveau
Hello, bonjour a tous, j'ai simulé l'ajout d'une nouvelle question à la fin du tableau (nouvelle ligne), et en testant ma macro de validation pour comptabiliser l'utilisation des questions (bouton en tête de colonne à gauche du bouton RAZ) jai constaté que la sélection de la colonne à copier et coller dans l'autre colonne ne prenait pas en compte la nouvelle ligne ajoutée. Je n'arrive pas à adapter mon code pour le rendre dynamique, afin qu'il prenne en compte toutes les futures lignes qui seront ajoutées. Merci pour vos conseils,
 
Vote positif 0 Vote négatif
A

Anais0998

XLDnaute Nouveau
ChTi160 à dit:
Bonjour Anais
Bonjour le Fil(Thomas) , le Forum
peut être ainsi
VB: 
 'après
If Range("TypeCertiphyto") = 3 Then
With Sheets("BddQuestions")
DerLgn = .Cells(.Rows.Count, 2).End(xlUp).Row 'détermine la dernière ligne Non Vide de la deuxième Colonne
                .Range("R2:R" & DerLgn).Copy 'On copie la palge ainsi définie
               .Range("N2:N" & DerLgn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                  :=False, Transpose:=False 'Et on la colle dans la plage
Application.CutCopyMode = False
End With
Else
Exit Sub
End If
jean marie
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
A

Anais0998

XLDnaute Nouveau
Bonjour ChTi10, merci bcp pour le code il fonctionne parfaitement. J'ai du mal avec les syntaxes grrr merci encore, je vais faire pareil pour la colonne NC4.
Après je dois trouver un moyen de masquer la colonne NC4 et son bouton de validation à l'ouverture de la feuille BddQuestions si le NC3 est sélectionné, et inversement avec le NC4.
Ensuite, je dois trouver un moyen de masquer les lignes "AV" dans la colonne "commission" de la BddQuestions à son ouverture;

Pour finir, je dois pouvoir lancer une impression qui imprimera et le sujet en 15 exemplaires 15 étiquettes 1 enveloppe la feuille correction (la plupart de ces feuilles ne figurent pas dans le fichier test qui a été allégé un max pour être posté.

Donc voilà j'ai encore du pain sur la planche, je vous tiens au courant et je ferais peut-être encore appel à vous en cas de blocage sévère ...
Merci encore à tous pour avoir pris le temps de m'aider.

Je ne ferme pas la discussion car j'espère toujours qu'un d'entre vous trouvera une idée pour alléger mon code et surtout pour allier le remplissage de la feuille SujetNC3 et le transfert du picto, qui fonctionne pour le moment mais à l'aide d'un bouton d'activation de la macro. Merci encore à tous et bon dimanche.
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
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
 

Pièces jointes

  • QCM EVALUATION CERTIPHYTO-Chti160-1.zip
    963.3 KB · Affichages: 6
Vote positif 0 Vote négatif

Discussions similaires

P
  • Question
Microsoft 365 Macro qui plante exel
Réponses
1
Affichages
453
mapomme
mapomme
P
  • Question
XL 2016 Affecter à un bouton plusieurs possibilité
Réponses
3
Affichages
505
Eric KERGRESSE
E
chilo27
  • Question
Autres Simplifier une macro
Réponses
1
Affichages
368
fanch55
fanch55
C
  • Question
Microsoft 365 Arret macro si condition est fausse
Réponses
4
Affichages
597
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
1 K
AnjyD
A
M
  • Question
XL 2010 Insérer 3 images
Réponses
11
Affichages
734
madoupa
M
N
  • Question
XL 2021 BESOIN D'aide macro
Réponses
7
Affichages
772
Gégé-45550
Gégé-45550
L
  • Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
801
fanfan38
fanfan38
A
  • Question
Microsoft 365 boucle macro pour importer des données
2
Réponses
16
Affichages
2 K
Arnaud Legay
A

Membres actuellement en ligne

1 membres et 38 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
315 097
Messages
2 116 186
Membres
112 679
dernier inscrit
Yupanki