Petit souci macro 2010

**docofchaos** · 17/07/2012, 10h24

Bonjour à tous,

J'ai un petit soucis que je vais essayer de détailler :

J'ai une feuille excel avec en première colonne n° ligne, 2 éme colonne, un lien vers une photo du disque dur,, le 3éme le nom de la photo.

J'ai déjà une macro qui fonctionnait sous 2003 qui effectuait l'insertion de la photo en fonction du lien. (en gros il récupére le lien et remplace par la photo)

Mais avec le passage a Excel 2010, une fois que j'ai effectué la macro, quand je réenregistre la feuille excel, les photos n'apparaissent plus (bizarre car avec 2003 pas de soucis)

J'ai eu beau chercher une solution potable, mes les utilisateurs doivent obligatoirement récupérer le fichier avec la photo sous une feuille excel.

Etant moyen dans Excel, si vous avez des idées je prend. Et au besoin je joindrais la macro.

cordialement doc'

**Daniel.C** · 17/07/2012, 10h54

Bonjour,

Et au besoin je joindrais la macro

Ça serait bien, oui.

**docofchaos** · 17/07/2012, 11h07

merci je te joins la macro (c'est un de mes collègues qui l'avais fait)

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
 
Public Sub InsertPhoto()
 
    'macro d'insertion des images dans les cellules  excel
 
 
    Set fp = ActiveWorkbook
 
    'vérification des paramètres en ligne 0 (envoyés par le php)
    booltrouve = False
    colonnephoto = 0
    largeurphoto = 0
 
    Set feuilllepdr = fp.ActiveSheet
 
    If (feuilllepdr.Cells(1, 1).Value = "Liste") Then
        booltrouve = True
        colonnephoto = feuilllepdr.Cells(1, 2).Value
        largeurphoto = feuilllepdr.Cells(1, 3).Value
        pathphoto = feuilllepdr.Cells(1, 4).Value
    Else
        MsgBox ("La feuille de calcul active n'est pas une liste ou les paramètres ne sont pas correct ! Merci de réessayer avec un autre fichier.")
        Exit Sub
    End If
 
    If (booltrouve = False Or colonnephoto = 0 Or largeurphoto = 0 Or pathphoto = "") Then
        MsgBox ("La feuille de calcul active n'est pas une liste ou les paramètres ne sont pas correct ! Merci de réessayer avec un autre fichier.")
        Exit Sub
    End If
 
    If Dir(pathphoto, vbDirectory) <> "" Then
        'boucle sur les enreg et importation de l'image
        lignemax = Range("A65536").End(xlUp).Row
        For ligne = 1 To lignemax
            'recuperation du link
            If feuilllepdr.Cells(ligne, colonnephoto).Hyperlinks.Count > 0 Then
                lienphoto = feuilllepdr.Cells(ligne, colonnephoto).Hyperlinks(1).Address
                'si c'est bien un lien vers fichier style file
                If (VBA.InStr(lienphoto, "file") > 0) Then
                    'insertion de l'image a l'emplacement de la cellule
                    feuilllepdr.Pictures.Insert(lienphoto).Select
                    Selection.Placement = xlMoveAndSize
                    With Selection.ShapeRange
                        .ScaleWidth 4, msoFalse, msoScaleFromTopLeft
                        .ScaleHeight 4, msoFalse, msoScaleFromTopLeft
                        .Width = largeurphoto
                        .Left = feuilllepdr.Cells(ligne, colonnephoto).Left + 8
                        .Top = feuilllepdr.Cells(ligne, colonnephoto).Top + 9
                    End With
                    'supprime le line aprés insertion de l'image
                    feuilllepdr.Cells(ligne, colonnephoto).Hyperlinks(1).Delete
                    feuilllepdr.Cells(ligne, colonnephoto).Value = ""
 
                    'mise en place du cadre
                    feuilllepdr.Cells(ligne, colonnephoto).Select
                    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                    With Selection.Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlEdgeRight)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                    End With
                End If
            End If
        Next
 
        'supprimme ensuite le dossier ou se trouvaient les photo
        Set FS = CreateObject("Scripting.FileSystemObject")
        FS.Deletefolder pathphoto, True
    Else
        MsgBox ("Le dossier : " + pathphoto + " contenant les photos pour cette extraction n'éxiste pas ! Relancez une extraction !")
    End If
 
End Sub

**Daniel.C** · 17/07/2012, 12h16

Bonjour,

Je pense que ça provient du fait que tu supprime le dossier contenant les images avant d'avoir enregistré le classeur. Avant l'enregistrement, les images ne sont pas incluses dans le classeur, mais sont liées aux images source. Essaie comme ceci :

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
Public Sub InsertPhoto()
 
    'macro d'insertion des images dans les cellules  excel
 
 
    Set fp = ActiveWorkbook
 
    'vérification des paramètres en ligne 0 (envoyés par le php)
    booltrouve = False
    colonnephoto = 0
    largeurphoto = 0
 
    Set feuilllepdr = fp.ActiveSheet
 
    If (feuilllepdr.Cells(1, 1).Value = "Liste") Then
        booltrouve = True
        colonnephoto = feuilllepdr.Cells(1, 2).Value
        largeurphoto = feuilllepdr.Cells(1, 3).Value
        pathphoto = feuilllepdr.Cells(1, 4).Value
    Else
        MsgBox ("La feuille de calcul active n'est pas une liste ou les paramètres ne sont pas correct ! Merci de réessayer avec un autre fichier.")
        Exit Sub
    End If
 
    If (booltrouve = False Or colonnephoto = 0 Or largeurphoto = 0 Or pathphoto = "") Then
        MsgBox ("La feuille de calcul active n'est pas une liste ou les paramètres ne sont pas correct ! Merci de réessayer avec un autre fichier.")
        Exit Sub
    End If
 
    If Dir(pathphoto, vbDirectory) <> "" Then
        'boucle sur les enreg et importation de l'image
        lignemax = Range("A65536").End(xlUp).Row
        For ligne = 1 To lignemax
            'recuperation du link
            If feuilllepdr.Cells(ligne, colonnephoto).Hyperlinks.Count > 0 Then
                lienphoto = feuilllepdr.Cells(ligne, colonnephoto).Hyperlinks(1).Address
                'si c'est bien un lien vers fichier style file
                If (VBA.InStr(lienphoto, "file") > 0) Then
                    'insertion de l'image a l'emplacement de la cellule
                    feuilllepdr.Pictures.Insert(lienphoto).Select
                    Selection.Placement = xlMoveAndSize
                    With Selection.ShapeRange
                        .ScaleWidth 4, msoFalse, msoScaleFromTopLeft
                        .ScaleHeight 4, msoFalse, msoScaleFromTopLeft
                        .Width = largeurphoto
                        .Left = feuilllepdr.Cells(ligne, colonnephoto).Left + 8
                        .Top = feuilllepdr.Cells(ligne, colonnephoto).Top + 9
                    End With
                    'supprime le line aprés insertion de l'image
                    feuilllepdr.Cells(ligne, colonnephoto).Hyperlinks(1).Delete
                    feuilllepdr.Cells(ligne, colonnephoto).Value = ""
 
                    'mise en place du cadre
                    feuilllepdr.Cells(ligne, colonnephoto).Select
                    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                    With Selection.Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                    End With
                    With Selection.Borders(xlEdgeRight)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                    End With
                End If
            End If
        Next
        ThisWorkbook.Save
        'supprimme ensuite le dossier ou se trouvaient les photo
        Set FS = CreateObject("Scripting.FileSystemObject")
        FS.Deletefolder pathphoto, True
    Else
        MsgBox ("Le dossier : " + pathphoto + " contenant les photos pour cette extraction n'éxiste pas ! Relancez une extraction !")
    End If
 
End Sub

En supposant que le classeur a déjà été enregistré.

**docofchaos** · 17/07/2012, 13h54

bonjour et merci de la réponse rapide.

Effectivement j'avais pensé à ce problème d'effacement.
Je viens de tester la macro modifier et non le problème reste toujours la (par contre il ne m'affiche plus image indisponible, mais rien dans la cellule)

J'avais pensé a intergrer directement les photo dans la feuille excel, mais malheureusement je n'y arrive pas :'(

**Daniel.C** · 17/07/2012, 14h02

Je n'ai pas dépouillé tout ton code qui est trop dépendant des données, mais j'ai fait un essai simple à partir d'un lien hypertexte :
1.
- insertion d'une image à partir du lien
- suppression du dossier contenant l'image.
- enregistrement du classeur.
- fermeture du classeur.
- à la réouverture, l'image a disparu.
2.
- insertion d'une image à partir du lien
- enregistrement du classeur.
- suppression du dossier contenant l'image.
- fermeture du classeur.
- à la réouverture, on retrouve l'image.

Petit souci macro 2010 [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager