Discussion :

[Victory94]

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

[Menhir]

un message d'erreur 1004 s'affiche.

Quel est le message d'erreur ?
Quel ligne de code est désignée par le débugage ?

[Victory94]

l'erreur est Microsoft EXCEL 1004, erreur définie par l'application ou par l'objet.
et la ligne désignée par le débugage est

Code :

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

lashape = ActiveSheet.Shapes(i).Name

[mercatog]

Quel horreur ce code

Pour le début, il suffirait de faire

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub maj_a3()
Dim Ws As Worksheet
Dim Shp As Shape
Dim LaShape As String
 
Application.ScreenUpdating = False
With Worksheets("A3")
    For Each Shp In .Shapes
        If Left(Shp.Name, 3) = "A3_" Then Shp.Delete
    Next Shp
End With
 
'...la suite

Pour les Select à tort et à travers, c'est juste une atrocité

[Victory94]

s'il te plait Mercatog, c'est quelle partie du code initial je dois remplacer par ta proposition?

[mercatog]

Rempkace de la ligne 12 à 26.

La suite pourra ĕtre adapté si tu essaies d'être plus claire