Discussion :

[Aline S]

Bonjour,

J'ai un souci aléatoire dans un fichier Excel :

Je travaille sur un outil dans lequel figure un onglet permettant d'ajouter des documents (pdf et images).
Y figurent 20 lignes avec chacune 3 boutons : ajouter, ouvrir, supprimer.

Et, parfois, sans afficher d'erreur, on ne peut plus ouvrir les pièces jointes (et dans ce cas, on ne peut plus, dans ce fichier Excel donné, ouvrir aucun document). Le bouton supprimer fonctionne sans problème.

J'ai pensé que ce pouvait être à cause du volume total de pièces jointes, mais il est arrivé que sur un doc Excel de 9Mo on ne puisse plus rien ouvrir, et que tout fonctionne parfaitement sur un doc Excel de 10Mo.

Bref, je n'ai aucune idée.
Je n'ai jamais réussir à créer ce problème (les seuls fichiers qui buggent que j'ai eu l'occasion de tester m'ont été envoyés par la filiale).
Je suis sur Excel 365 et la filiale sur Excel 2007.

Est-ce que l'un de vous aurait une suggestion ?

Merci de m'avoir lu,
Aline

Ci-après les 3 codes d'ajout, ouverture suppression :

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
Sub InsertFile(FileCell As String)
 
Dim Obj As OLEObject
 
Dim Chemin As Variant
 
Dim T As String
 
If ActiveSheet.Range(FileCell).Offset(0, 1).Value = "" Then
    MsgBox "Veuillez renseigner un type de document avant de l'insérer"
    Exit Sub
End If
 
 
    'Choix du fichier PDF ou IMAGE
 
    Chemin = Application.GetOpenFilename("PDF File,*.pdf, Image File, *.jpg;*.jpeg;*.png;*.bmp", Title:="Choisir le fichier à insérer")
 
    If Chemin = False Then Exit Sub
 
    Application.ScreenUpdating = False
 
    'Création nouveau document
 
    UnProtectSheet ActiveSheet.Name, GetFicConfig
 
    With ActiveSheet
 
        'Insertion de l'objet PDF
 
        Set Obj = .OLEObjects.Add(Filename:=Chemin, Link:=False, DisplayAsIcon:=False, Iconlabel:="")
 
    End With
 
    Obj.Left = ActiveSheet.Range(FileCell).Left
    Obj.Top = ActiveSheet.Range(FileCell).Top
    Obj.Width = ActiveSheet.Range(FileCell).Width
    Obj.Height = ActiveSheet.Range(FileCell).Height
 
    Obj.Name = "Document " & Right(FileCell, Len(FileCell) - 1)
 
    ActiveSheet.Range(FileCell).Offset(0, 3).Value = "ü"
 
    ProtectSheet ActiveSheet.Name, GetFicConfig, False
 
    Application.ScreenUpdating = True
 
End Sub

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
Sub DeleteFile(NDoc As Integer)
 
Dim o As Shape
 
On Error Resume Next
Set o = ActiveSheet.Shapes("Document " & NDoc)
If Not o Is Nothing Then
    If MsgBox("Voulez-vous vraiment supprimer ce document ?", vbYesNo, "Confirmation") = vbYes Then
        UnProtectSheet ActiveSheet.Name, GetFicConfig
        ActiveSheet.Shapes("Document " & NDoc).Delete
        ActiveSheet.Range("E" & NDoc) = ""
        ActiveSheet.Range("C" & NDoc) = ""
        ProtectSheet ActiveSheet.Name, GetFicConfig, False
    End If
End If
End Sub

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
Sub OpenFile(NDoc As Integer)
Dim o As Shape
 
On Error Resume Next
 
Set o = ActiveSheet.Shapes("Document " & NDoc)
If Not o Is Nothing Then
    UnProtectSheet ActiveSheet.Name, GetFicConfig
    ActiveSheet.Shapes("Document " & NDoc).Select
    Selection.Verb Verb:=xlPrimary
    ActiveSheet.Range("C" & NDoc).Select
    ProtectSheet ActiveSheet.Name, GetFicConfig, False
End If
 
End Sub

[Phil Free]

Bonjour,

pas étonné de ce qui t'arrive ! alors serte cela ne vas pas t'aider de dire que excel n'est ni un répertoire ni une base de données. Faut vraiment éviter de l'utiliser de cette façon.
j'ai quelques personnes autour de moi au boulot qui on exactement les mêmes difficultés... et je pense qu'il n'y pas de solution à ce probleme qui oui reste aléatoire et sans raison apparente.

il faut revoir ta façon d'utiliser excel ! j'ai un peu l'impression de te dire : explique moi ton besoin je vais t'expliquer comment t'en passer... mais la...

[Aline S]

Bonjour Phil,

Merci de ton retour
Oui, je sais que ce n'est pas idéal, mais c'est pour une petite filiale, et pour l'instant nous n'envisageons pas autre chose qu'une solution tactique.

Bon, par contre, quand je disais qu'il n'y avait pas d'erreur...
J'oubliais qu'il y avait un mignon "On Error resume next".
Bref, le code qui fait planter est "Selection.Verb Verb:=xlPrimary".

J'ai tout changé, et j'ai fait un truc un peu sale je crois (en meme temps, ne connaissant que peu le vba, je ne fais que du sale), ou je copie colle la miniature créée à l'insertion dans un autre onglet, et l'agrandis à sa taille d'origine.
Chez moi, ça marche, j'ai envoyé à la filiale pour test.

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
Sub OpenFile(NDoc As Integer)
Dim o As Shape
 
On Error Resume Next
 
Set o = ActiveSheet.Shapes("Document " & NDoc)
 
If Not o Is Nothing Then
    efface_img
    HDoc = ActiveSheet.Cells(NDoc, 8).Value
    WDoc = ActiveSheet.Cells(NDoc, 9).Value
    'UnProtectSheet ActiveSheet.Name, GetFicConfig
    ActiveSheet.Shapes("Document " & NDoc).Select
    ActiveSheet.Shapes("Document " & NDoc).Copy
    Sheets("DOC_VIEW").Select
    ActiveSheet.Paste
    Selection.Width = WDoc
    Selection.Height = HDoc
    Selection.Top = 1
    Selection.Left = 1
End If
 
End Sub