Discussion :

[ALEX80800]

Bonjour,

Suivant cette macro, quelque personne n'ont pas l'affichage de l'image.

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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Shp As Shape
Dim Pt As PivotTable
Dim y As String
Dim LAnnee As String
Dim LActivite As String
Dim LLibelle As String
Dim LCompte As String
 
 On Error GoTo errorHandler
 Application.ScreenUpdating = False
 
 
 
'******************************************************************************************************
'******************Adresse où a eu lieu le double clic *************************************************
'******************************************************************************************************
 
y = Target.Address
Worksheets("TCD").Range("F1").Value = y
Worksheets("TCD").Range("E1").Value = ActiveSheet.Name
 
Cancel = True
DelShp
 
'******************************************************************************************************
''*****************************************************************************************************
'''****************************************************************************************************
 
LAnnee = Worksheets("TCD").Range("C1").Value
LActivite = Worksheets("TCD").Range("C2").Value
LLibelle = Worksheets("TCD").Range("C3").Value
LCompte = Worksheets("TCD").Range("C4").Value
 
 If Target.Column = 5 Then
 
 Set Pt = Worksheets("TCD").PivotTables("GL")
With Pt
 
                With Pt.PivotFields("Année")
                    .ClearAllFilters
                    .CurrentPage = LAnnee
                End With
 
                With Pt.PivotFields("Activité")
                    .ClearAllFilters
                    .CurrentPage = LActivite
                End With
 
                With Pt.PivotFields("Libellé_synergie")
                    .ClearAllFilters
                    .CurrentPage = LLibelle
                End With
 
               With Pt.PivotFields("Compte")
                    .ClearAllFilters
                    .CurrentPage = LCompte
                End With
 
End With
 
 ThisWorkbook.RefreshAll
 
 Sheets("TCD").Range("a5:n45").Copy
    Pictures.Paste
    Application.CutCopyMode = False
    Set Shp = Shapes(Shapes.Count)
    Shp.Top = Target.Offset(1, 0).Top
    Set Shp = Nothing
 
 End If
 
 
 Set Pt = Nothing
 
 
  If Not Application.Intersect(Target, Range("C6510:C8607")) Is Nothing Then
 
 
 
 Sheets("Detailchariot").Range("A1:M4").Copy
    Pictures.Paste
    Application.CutCopyMode = False
    Set Shp = Shapes(Shapes.Count)
    Shp.Top = Target.Offset(1, 0).Top
    Set Shp = Nothing
 
    ElseIf Not Application.Intersect(Target, Range("C8640:C10724")) Is Nothing Then
 
 
 
 
    Sheets("Detailchariot").Range("N1:Z4").Copy
    Pictures.Paste
    Application.CutCopyMode = False
    Set Shp = Shapes(Shapes.Count)
    Shp.Top = Target.Offset(1, 0).Top
    Set Shp = Nothing
 
 
 End If
 
 
 
errorHandler:
Exit Sub
 
 
Application.ScreenUpdating = True
 
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
DelShp
End Sub
 
'Efface toutes les images de la feuille
Private Sub DelShp()
Dim Shp As Shape
 
For Each Shp In Shapes
    If Shp.Type = msoPicture Then Shp.Delete
Next Shp
End Sub

Y-a-t-il un paramètre a effectué sur le PC

merci de votre réponse

[patricktoulon]

Bonjour
juste en survolant le code je suis quasiment certain que personne ne voit les images

Code :

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

1
2
Sheets("Detailchariot").Range("N1:Z4").Copy
    Pictures.Paste

Code :

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

Pictures.Paste '???????????????????????????????

ce serait pas plutôt ca

Code :

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

1
2
3
4
5
6
7
8
9
with Sheets("Detailchariot")
.Range("N1:Z4").Copy
.paste
'replacement de l'image en top et left ici
' avec 
'.pictures(.pictures.count).left=...
'.pictures(.pictures.count).top=...
'etc....(width/height/bordures/etc....)
end with

et pour ton delete global d'image
seules les pictures seront effacées les shapes ou autres object pouvant être pris en compte dans la collection shapes seront épargnés

Code :

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

1
2
3
 for each pict in sheets("blablabla").pictures
pict.delete
next

[Menhir]

Commence par supprimer le On Error GoTo errorHandler en début de code et peut-être auras-tu une meilleure idée de la nature du problème.

[ALEX80800]

Patrick,

Bonjour
juste en survolant le code je suis quasiment certain que personne ne voit les images

A parier ta belle-mère?

Et si cela fonctionne à 98.5% pour tout le monde

[patricktoulon]

re
parier ma belle mère!! ohh que oui a 100% et j'espère perdre
ce la dit pour être sérieux je n'ai pas tester "picture.paste" mais c'est pas très catholique a mon avis

98.5%!!!! y en a beaucoup comme moi qui doivent détester leur belle mère

je vais regarder dans le doute

bon: ben j'ai regardé et l'aide sur ce point est ambiguë


Alors j'ai testé
et sans surprise j'ai un bon ding et une belle ligne jaune



n'attends dimanche pour apporter des fleurs a ta belle mère VILAIN !!!!

[Arkham46]

Bonjour,

Je note déjà que ScreenUpdating est remis à True après un exit sub, donc jamais.

Sinon comme soulevé par Menhir, la gestion d'erreur telle que codée masque les erreurs.
Mettre au moins un MsgBox pour afficher une éventuelle erreur (mais pas après le exit sub).

[Arkham46]

Patrick,

Le code initial est :

Code :

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

Pictures.Paste

Tu testes la méthode paste sur un objet picture et non pas sur la colection pictures.
Donc rien à voir...

Par contre j'ajouterais qu'il serait utile de vérifier la config des utilisateurs chez qui cela ne fonctionne pas : version d'office notamment ?

[patricktoulon]

re
Ok Arkham46 autant pour moi ,je viens de tester ca colle mais dans le sheets
.paste ferait tout aussi bien