Macro incompatible avec Excel 2007

[romain95]

Bonjour,

J'ai une macro que j'ai créée sous Excel 2003 mais qui est incompatible avec Excel 2007.
J'ai désactivé les sécurités, télécharger un pack de compatibilité, mais rien n'y fait.
Je crois que la seule option est de modifier le code.

Le voici :

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Val As String
Dim MyCell As Range
Dim MyPicture As Picture
Dim Pict

On Error GoTo errorhandler
Application.ScreenUpdating = False

Val = Target.Value

With Application.FileSearch
.NewSearch
.Filename = ".jpg"
.LookIn = ThisWorkbook.Path
.SearchSubFolders = False
.Execute msoSortByFileName, msoSortOrderAscending

If .Execute > 0 Then
Set MyCell = Target.Offset(0, 1)
MyCell.Select

For Each Pict In ActiveSheet.DrawingObjects ' supprimer ancienne image dans cellule
If Pict.Left = MyCell.Left And Pict.Top = MyCell.Top Then Pict.Delete
Next

Set MyPicture = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Val & ".jpg")
With MyPicture.ShapeRange
.LockAspectRatio = msoFalse
.Height = MyCell.Height
.Width = MyCell.Width
End With
MyCell.Select
End If

End With
Application.ScreenUpdating = True
Exit Sub
errorhandler:
Application.ScreenUpdating = True
Exit Sub
End Sub


Si quelqu'un peut me dire exactement ce qu'il y a à modifier se serait super cool.

Cordialement,

Romain

 

[Roland_M]

Re : Macro incompatible avec Excel 2007

bonjour

si tu nous disais sur quelle ligne ça bug ?

EDIT

je crois que Application.FileSearch n'existe plus sous 2007 !?

 

[Roland_M]

Re : Macro incompatible avec Excel 2007

re

il faudrait effectivement modifier le code ou voir ici . . .

Un complément FileSearch pour Excel 2007 - Club des décideurs et professionnels en Informatique


EDIT : pour modifier le code . . .

à la place de > With Application.FileSearch
mettre ceci(à adapter) > Fichier = Dir(Chemin & DirFileName)
à la place de > If .Execute > 0 Then
mettre ceci > If Fichier > "" Then

'ne pas oublier d'enlever en bas de ton code End With

 

[romain95]

Re : Macro incompatible avec Excel 2007

Merci beaucoup Roland,

J'ai oublié une précision importante, je suis novice en VBA.
En fait, ce code je ne l'ai pas créé, je l'avais récupéré sur le forum.
Je viens d'essayer les choses que tu viens de me donner mais je n'y arrive pas.
Est ce que tu pourrais me reprendre mon code et m'apporter les modifications nécessaire?

Ce serait super cool.

Désolé de demander que tu me mâche le travail mais là ça fait 2 heures que je galère à essayer des modifications.

Je n'arrive pas à voir la ligne qui bug (en faisant F8) je suis vraiment désolé

Désolé je suis certainement un boulet sur ce coup...

 

[Minick]

Re : Macro incompatible avec Excel 2007

Salut,

Une autre possibilite avec FileSystemObject

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim Val As String
    Dim MyCell As Range
    Dim MyPicture As Picture
    Dim Pict
    
    Dim fs, Dossier, Fichier, Fichiers
    
    On Error GoTo errorhandler
    Application.ScreenUpdating = False
    
    [COLOR=Red]Val = Target.Value[/COLOR]

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set Dossier = fs.GetFolder(ThisWorkbook.Path)
    Set Fichiers = Dossier.Files
    For Each Fichier In Fichiers
        If LCase(Right(Fichier.Name, 3)) = "jpg" Then
            Set MyCell = Target.Offset(0, 1)
            MyCell.Select
            
            For Each Pict In ActiveSheet.DrawingObjects ' supprimer ancienne image dans cellule
               If Pict.Left = MyCell.Left And Pict.Top = MyCell.Top Then Pict.Delete
            Next
            
            Set MyPicture = ActiveSheet.Pictures.Insert([COLOR=Red]ThisWorkbook.Path & "\" & Val & ".jpg"[/COLOR])
            With MyPicture.ShapeRange
                .LockAspectRatio = msoFalse
                .Height = MyCell.Height
                .Width = MyCell.Width
            End With
            MyCell.Select
        End If
    Next

errorhandler:
    Application.ScreenUpdating = True
End Sub

Par contre je ne vois pas l'interet de boucler sur les fichiers images pour au final toujours afficher la meme image
, code que j'ai mi en rouge.

 

[Roland_M]

Re : Macro incompatible avec Excel 2007

re

essai comme ceci :

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim MyCell As Range
Dim MyPicture As Picture
Dim Pict
Dim Fichier$, CheminFichier$

On Error GoTo errorhandler
Application.ScreenUpdating = False

' initialise var nécessaire
Fichier = Target.Value & ".jpg" 'nom du fichier image dans cette cellule avec l'extention
CheminFichier = ThisWorkbook.Path & "\" & Fichier ' chemin complet avec nom fichier image

Fichier = Dir(CheminFichier)
If Fichier > "" Then
   Set MyCell = Target.Offset(0, 1): MyCell.Select

   For Each Pict In ActiveSheet.DrawingObjects ' supprimer ancienne image dans cellule
    If Pict.Left = MyCell.Left And Pict.Top = MyCell.Top Then Pict.Delete
   Next

   Set MyPicture = ActiveSheet.Pictures.Insert(CheminFichier)
   With MyPicture.ShapeRange
    .LockAspectRatio = msoFalse
    .Height = MyCell.Height
    .Width = MyCell.Width
   End With
   MyCell.Select
End If

errorhandler: ' arrivée erreur et comme il n'y a pas de traitement, idem sortie fin de la macro
Application.ScreenUpdating = True
On Error GoTo 0: Err.Clear
End Sub

 

[romain95]

Re : Macro incompatible avec Excel 2007

Merci pour ta rapidité,

Merci beaucoup, ton code fonctionne bien, mais il reste quelques soucis.
En fait je ne reboucle pas sur la même image. Il y a plusieurs images. En fonction de la sélection faite dans une liste déroulante, une image correspondante s'affiche.
Dans la colonne D j'ai mes listes déroulantes et dans ma colonne E j'ai ma représentation correspondante.

Le souci avec ton code c'est que mes images ne se calent plus dans les cases de la colonne E;

Explication : quand je fais ma sélection dans ma liste déroulante en D7, je souhaiterais que l'image correspondante apparaisse en E7. Et ceci pour chaque ligne. Et quand je supprime le contenu de ma liste déroulante, que l'image correspondante s'efface (quand je supprime le contenu de ma case D7, l'image en E7 disparait)

Peux tu encore m'aider

Cordialement,

Romain

 

[Minick]

Re : Macro incompatible avec Excel 2007

Au temps pour moi, c'est moi qui ai ajoute une boucle la ou il n'y en avait pas.
Par contre, chez moi l'image est bien ajoute a la cellule a droite de la cellule modifiee...

Ci-joint la correction pour la boucle inutile.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim Val As String
    Dim MyCell As Range
    Dim MyPicture As Picture
    Dim Pict
    Dim fs
    
    On Error GoTo errorhandler
    Application.ScreenUpdating = False
    
    Val = Target.Value
    Set MyCell = Target.Offset(0, 1)
    MyCell.Select

    For Each Pict In ActiveSheet.DrawingObjects ' supprimer ancienne image dans cellule
       If Pict.Left = MyCell.Left And Pict.Top = MyCell.Top Then Pict.Delete
    Next
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.fileexists(ThisWorkbook.Path & "\" & Val & ".jpg") Then
        Set MyPicture = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Val & ".jpg")
        With MyPicture.ShapeRange
            .LockAspectRatio = msoFalse
            .Height = MyCell.Height
            .Width = MyCell.Width
        End With
        MyCell.Select
    End If

errorhandler:
    Set fs = Nothing
    Application.ScreenUpdating = True
End Sub

EDIT:
J'ai oublie de preciser que j'etais sous xl2003, ce qui explique peut etre le mauvais placement de l'image chez toi.

 

[romain95]

Re : Macro incompatible avec Excel 2007

Merci encore Roland,

J'ai toujours le même problème avec le nouveau code.
Les images sélectionnées apparaissent bien, mais pas à l'endroit souhaité.
Elles apparaissent toujours en haut à gauche du document...De plus, elles ne s'effacent pas quand la sélection dans la liste déroulante est vide...
Si tu peux faire qqc

Merci encore

Cordialement,

Romain

 

[Roland_M]

Re : Macro incompatible avec Excel 2007

re

chez moi tout fonctionne ! idem sous 2003 !

mais je dois préciser que l'erreur de placement sur une cellule est un bug de 2007
il faut que tu restes en Zoom 100% sinon c'est placé à côté !

sinon l'image ne place pas correctement et ton test Left est faux !
c'est pourquoi, entres autres, je déconseille 2007 !

voir test ci-joint !

 

[romain95]

Re : Macro incompatible avec Excel 2007

Bonjour Roland,

Désolé de ne pas avoir répondu plus tôt. Merci encore pour ton aide.
Par contre même en affichage 100%, (et même 200%) les images ne se placent toujours pas au bon endroit. Elles se mettent en haut à gauche encore une fois.
Si tu ne peux plus m'aider, je comprendrais sachant que chez toi tout fonctionne...

Dis moi si t'as encore une idée!!

Merci encore,

Cordialement,

Romain

 

[Roland_M]

Re : Macro incompatible avec Excel 2007

re

voir ci-joint !

mais en 100% !

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyCell As Range
Dim MyPicture As Picture
Dim Pict As Picture
Dim Fichier$, CheminFichier$

On Error GoTo errorhandler
Application.ScreenUpdating = False

' initialise var nécessaire
Fichier = Target.Value & ".jpg" 'nom du fichier image dans cette cellule avec l'extention
CheminFichier = ThisWorkbook.Path & "\" & Fichier ' chemin complet avec nom fichier image

Fichier = Dir(CheminFichier)
If Fichier > "" Then
   Set MyCell = Target.Offset(0, 1): MyCell.Select

   For Each Pict In ActiveSheet.DrawingObjects ' supprimer ancienne image dans cellule
    If Pict.Left = MyCell.Left And Pict.Top = MyCell.Top Then Pict.Delete
   Next

   Set MyPicture = ActiveSheet.Pictures.Insert(CheminFichier)
   With MyPicture.ShapeRange
    .LockAspectRatio = msoFalse
    .Top = MyCell.Top
    .Left = MyCell.Left
    .Height = MyCell.Height
    .Width = MyCell.Width
   End With
   MyCell.Select
End If

errorhandler: ' arrivée erreur et comme il n'y a pas de traitement, idem sortie fin de la macro
Application.ScreenUpdating = True
On Error GoTo 0: Err.Clear
End Sub

 

[MJ13]

Re : Macro incompatible avec Excel 2007

Bonjour à tous

Roland t'y va u peu fort sur XL2007 . Bon c'est vrai que sur ce coup c'est pas top. En plus, maintenant de nombreuses actions sur les objets ne sont plus enregistrés avec l'enregistreur de macros.

A tester lorsque l'image ne se place pas au bon endroit sur XL2007 (sinon les autres codes doivent fonctionner).

'Pour XL2007
Selection.Cut
ActiveCell.PasteSpecial (1)
Selection.Placement = xlMoveAndSize
'Pour XL2007

 

[Roland_M]

Re : Macro incompatible avec Excel 2007

salut à toi MJ13 !

Ok Ok Ok je suis toujours un peu excessif

j'ai retiré !

mais j'ai solutionné !

merci quand même pour l'info !

 

[romain95]

Re : Macro incompatible avec Excel 2007

Salut Roland,

Désolé de te dire qu'avec le dernier code, je n'ai même plus d'image qui apparaisse quand je fais ma sélection dans une de mes listes déroulantes...
Merci encore une fois de m'avoir consacré du temps...


Amicalement,

Romain