Bonjour,
je travaille actuellement sur un fichier EXCEL, il s'agit d'un tableau de bord qui a un onglet de synthèse qui récupère des images à partir des autres onglets. Sur cet onglet, figure un bouton de mise à jour. En effet au niveau de ce bouton, je bute sur un problème, lorsque je change les images sur les autres onglets, et je clique sur le bouton de mise à jour, toutes les images sur l'onglet de synthèse disparaissent et un message d'erreur 1004 s'affiche. Je ne sais pas quelle partie du code qui crée le problème, s'il vous plait si vous pouvez m'aider à trouver une solution ou me corriger le code, ou sinon me proposer un autre code, je vous serai très reconnaissante. voila le code VBA de la macro.
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
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Sub maj_a3()
Dim lasheet, letop, leleft, lashape
Dim lazone, ladest
Dim nbsh
Application.ScreenUpdating = False
 
                Sheets("A3").Select
nbsh = ActiveSheet.Shapes.Count
For i = 1 To nbsh
    lashape = ActiveSheet.Shapes(i).Name
 
    If Mid(lashape, 1, 3) = "A3_" Then
        ActiveSheet.Shapes(lashape).Delete
        i = i - 1
        nbsh = ActiveSheet.Shapes.Count
        If i = nbsh Then
            Exit For
        End If
    End If
Next
 
For i = 1 To ActiveWorkbook.Sheets.Count
On Error GoTo Errorshape
 
    If Sheets(i).Name <> "A3" And Sheets(i).Name <> "Parametres_Bandeau" Then ' on ne vas pas sur les feilles a3 et maj bandeau
        lasheet = Sheets(i).Name
        Sheets("A3").Select
        lashape = "A3_" & lasheet
        If Len(lashape) > 31 Then
            Sheets(lasheet).Name = Mid(Sheets(lasheet).Name, 1, 28)
            lasheet = Sheets(i).Name
        End If
'        ActiveSheet.Shapes(lashape).Select
'        ActiveSheet.Shapes(lashape).Delete
 
pasdel:
        ActiveWorkbook.Sheets(lasheet).Select
        lazone = Sheets(lasheet).Cells(1, 2).Value
        ladest = Sheets(lasheet).Cells(2, 2).Value
        Application.CutCopyMode = False
 
        ActiveWorkbook.Sheets(lasheet).Range(lazone).Copy
        Sheets("A3").Select
        Range(ladest).Select
        letop = ActiveCell.Top
        leleft = ActiveCell.Left
        ActiveSheet.Shapes("image_copy").Select
        ActiveSheet.Paste
        Selection.Name = lashape
        Selection.ShapeRange.IncrementTop letop
        Selection.ShapeRange.IncrementLeft leleft
        Selection.ShapeRange.Fill.Visible = msoTrue
        Selection.ShapeRange.Fill.Solid
        Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
        Selection.ShapeRange.Fill.Transparency = 0#
        Selection.ShapeRange.Line.Weight = 0.75
        Selection.ShapeRange.Line.DashStyle = msoLineSolid
        Selection.ShapeRange.Line.Style = msoLineSingle
        Selection.ShapeRange.Line.Transparency = 0#
        Selection.ShapeRange.Line.Visible = msoFalse
 
        ActiveSheet.Shapes(lashape).Select
        ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Shapes(lashape), Address:="", SubAddress:="'" & lasheet & "'!A3"
 
        OpenClipboard 0
        EmptyClipboard
        CloseClipboard
 
    End If
Next
Range("O1").Select
Application.ScreenUpdating = True
 
Exit Sub
 
Errorshape:
If Err.Number = -2147024809 Then
    GoTo pasdel
End If
 
MsgBox (Str(Err.Number))
MsgBox Err.Description
 
End Sub