Discussion :

[iio0n]

Bonjour

J'ai quelque soucis avec une macro. Voici le code actuel:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Private Sub EG_Click()
' Copier coller graph avec Bouton
If EG1.Value = True Then
    Sheets("I1").Select
    Worksheets("I1").ChartObjects("GI1").Copy
    Worksheets("Graphes").Range("A1").PasteSpecial
    Worksheets("I1").ChartObjects("GI1-2").Copy
    Worksheets("Graphes").Range("K1").PasteSpecial
End If
If EG2.Value = True Then
    Sheets("I2").Select
    Worksheets("I2").ChartObjects("GI2").Copy
    Worksheets("Graphes").Range("A17").PasteSpecial
    Worksheets("I2").ChartObjects("GI2-2").Copy
    Worksheets("Graphes").Range("K17").PasteSpecial
End If
If EG3.Value = True Then
    Sheets("I3").Select
    Worksheets("I3").ChartObjects("GI3").Copy
    Worksheets("Graphes").Range("A33").PasteSpecial
    Worksheets("I3").ChartObjects("GI3-2").Copy
    Worksheets("Graphes").Range("K33").PasteSpecial
End If
If EG4.Value = True Then
    Sheets("I4").Select
    Worksheets("I4").ChartObjects("GI4").Copy
    Worksheets("Graphes").Range("A48").PasteSpecial
End If
If EG5.Value = True Then
    Sheets("I5").Select
    Worksheets("I5").ChartObjects("GI5").Copy
    Worksheets("Graphes").Range("A63").PasteSpecial
End If
If EG6.Value = True Then
    Sheets("I6").Select
    Worksheets("I6").ChartObjects("GI6").Copy
    Worksheets("Graphes").Range("A78").PasteSpecial
End If
If EG8.Value = True Then
    Sheets("I8").Select
    Worksheets("I8").ChartObjects("GI8").Copy
    Worksheets("Graphes").Range("A93").PasteSpecial
    Worksheets("I8").ChartObjects("GI8-2").Copy
    Worksheets("Graphes").Range("K93").PasteSpecial
End If
If EG9.Value = True Then
    Sheets("I9").Select
    Worksheets("I9").ChartObjects("GI9").Copy
    Worksheets("Graphes").Range("A108").PasteSpecial
    Worksheets("I9").ChartObjects("GI9-2").Copy
    Worksheets("Graphes").Range("A127").PasteSpecial
End If
If EG11.Value = True Then
    Sheets("I11").Select
    Worksheets("I11").ChartObjects("GI11").Copy
    Worksheets("Graphes").Range("A147").PasteSpecial
End If
End Sub

Ce code me permet de coller les images demandés (sélection de case et click pour copier/coller les images et les mettre dans un autre onglet).

Le seul soucis, c'est que j'ai fixer le collage à un endroit spécifique pour chaque images.
De ce fait, il arrive qu'il y est des trous entre chacune d'entre elles.

Comment supprimer ces lignes vides?

J'avais pensé à incrémenter mais je ne sais pas exactement comment m'y prendre...

Pourriez vous me donner un coup de main s'il vous plaît?

Cordialement,

Marion

[keygen08]

Bonjour, au plus simple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Private Sub EG_Click()
Dim r As Integer
' Copier coller graph avec Bouton
r = 1
If EG1.Value = True Then
    Sheets("I1").Select
    Worksheets("I1").ChartObjects("GI1").Copy
    Worksheets("Graphes").Range("A" & r).PasteSpecial
    Worksheets("I1").ChartObjects("GI1-2").Copy
    Worksheets("Graphes").Range("K" & r).PasteSpecial
    r = r + 16
End If
If EG2.Value = True Then
    Sheets("I2").Select
    Worksheets("I2").ChartObjects("GI2").Copy
    Worksheets("Graphes").Range("A" & r).PasteSpecial
    Worksheets("I2").ChartObjects("GI2-2").Copy
    Worksheets("Graphes").Range("K" & r).PasteSpecial
    r = r + 16
End If
If EG3.Value = True Then
    Sheets("I3").Select
    Worksheets("I3").ChartObjects("GI3").Copy
    Worksheets("Graphes").Range("A" & r).PasteSpecial
    Worksheets("I3").ChartObjects("GI3-2").Copy
    Worksheets("Graphes").Range("K" & r).PasteSpecial
    r = r + 15
End If
If EG4.Value = True Then
    Sheets("I4").Select
    Worksheets("I4").ChartObjects("GI4").Copy
    Worksheets("Graphes").Range("A" & r).PasteSpecial
    r = r + 15
End If
If EG5.Value = True Then
    Sheets("I5").Select
    Worksheets("I5").ChartObjects("GI5").Copy
    Worksheets("Graphes").Range("A" & r).PasteSpecial
    r = r + 15
End If
If EG6.Value = True Then
    Sheets("I6").Select
    Worksheets("I6").ChartObjects("GI6").Copy
    Worksheets("Graphes").Range("A" & r).PasteSpecial
    r = r + 15
End If
If EG8.Value = True Then
    Sheets("I8").Select
    Worksheets("I8").ChartObjects("GI8").Copy
    Worksheets("Graphes").Range("A" & r).PasteSpecial
    Worksheets("I8").ChartObjects("GI8-2").Copy
    Worksheets("Graphes").Range("K & r").PasteSpecial
    r = r + 15
End If
If EG9.Value = True Then
    Sheets("I9").Select
    Worksheets("I9").ChartObjects("GI9").Copy
    Worksheets("Graphes").Range("A" & r).PasteSpecial
    Worksheets("I9").ChartObjects("GI9-2").Copy
    Worksheets("Graphes").Range("A" & r).PasteSpecial
    r = r + 15
End If
If EG11.Value = True Then
    Sheets("I11").Select
    Worksheets("I11").ChartObjects("GI11").Copy
    Worksheets("Graphes").Range("A" & r).PasteSpecial
    r = r + 18
End If
r = 0
End Sub