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

re

romain peux tu joindre ton classeur ?
car je me demande comment tu pratiques !

car ce code fonctionne y compris sur 2007 ! je l'ai essayé !

exemple :
(avec image que j'ai mis dans ce même répertoire)
je suis placé sur la cellule A10 et j'y entre le nom d'image
et bien lorsque je valide j'ai l'image en face en B10 !

 

[romain95]

Re : Macro incompatible avec Excel 2007

Je t'envoie ça dès ce soir. Merci Roland.

Romain

 

[romain95]

Re : Macro incompatible avec Excel 2007

Bonjour Roland,

Excuse moi pour le retard. J'ai un souci de taille de fichier. Il fait 250Ko et je n'arrive plus à le réduire (enlever les mises en formes inutiles, compresser le fichier...).
Est ce que je peux t'envoyer ça à une adresse mail ?

Cordialement,

Romain

 

[Roland_M]

Re : Macro incompatible avec Excel 2007

re

houla ! j'espère que ce n'est pas une usine à gaz !

place le là:

Cijoint.fr - Service gratuit de dépôt de fichiers

 

[romain95]

Re : Macro incompatible avec Excel 2007

Voici le lien

Ne t'inquiète pas, je n'ai laissé que la partie qui nous intéresse

Cijoint.fr - Service gratuit de dépôt de fichiers

Cordialement,

Romain

Cordialement,

Romain

 

[Roland_M]

Re : Macro incompatible avec Excel 2007

re

l'erreur vient d'ici !
For Each Pict In ActiveSheet.DrawingObjects ' supprimer ancienne image dans cellule
tu mets ceci et ça fonctionne
For Each Pict In ActiveSheet.ChartObjects ' supprimer ancienne image dans cellule

 

[romain95]

Re : Macro incompatible avec Excel 2007

MAGNIFIQUE. Tout fonctionne

Merci beaucoup pour tout ce temps passé à m'aider.

Encore une fois mille merci

Cordialement,

Romain

 

[romain95]

Re : Macro incompatible avec Excel 2007

Excuse moi mais j'ai parlé un peu vite.
Il subsiste un dernier problème, l'image ne s'efface pas quand je sélectionne dans ma liste déroulante le choix vide (1er choix dans la liste)

Désolé de te demander encore un peu d'aide...

Cordialement,

Romain

 

[Roland_M]

Re : Macro incompatible avec Excel 2007

re

reprendre ton Sub complet ! j'ai rajouté un test d'erreur !
MODIF IMPORTANTE !
j'ai mis ceci > ActiveSheet.Shapes ! pour la recherche c'est mieux !
car le test .left et .top n'est pas fiable !

Mais il faut savoir que toutes images dont le nom commence par "Picture" seront supprimé !

J'espère que tu n'en a pas dans ton classeur !?
sinon il te faut les renommer avant de lancer un appel d'images !

à part cela ça ne pose pas d'autre problème !

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

On Error GoTo ErrorHandler
Application.ScreenUpdating = False

' définit la cellule qui accueil l'image (devant la cellule active !)
Set MyCell = Target.Offset(0, 1): MyCell.Select
' supprime toutes les images nommées "Picture no"
For Each Pict In ActiveSheet.Shapes
 If Left(Pict.Name, 7) = "Picture" Then Pict.Delete
Next
' si un nom sélectionné . . .
If Trim(Target.Value) > "" Then
   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 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
End If
'fin sortie
Application.ScreenUpdating = True
On Error GoTo 0: Err.Clear
Exit Sub

ErrorHandler: 'traitement d'erreur
Dim Msg$
Application.ScreenUpdating = True
Msg = "Erreur " & Err.Source & "  No " & Err.Number & vbLf & vbLf & Err.Description
MsgBox Msg, vbCritical, "", Err.HelpFile, Err.HelpContext
On Error GoTo 0: Err.Clear
End Sub

 

[romain95]

Re : Macro incompatible avec Excel 2007

re

J'ai toujours le même souci d'effacement d'image qui ne se réalise pas.

Je t'explique ce que je souhaiterais avoir à partir du document que je t'ai envoyé :

Quand je sélectionne en A3 dans ma liste déroulante "Lever debout", l'image correspondante apparait bien en B3 au bon format (jusqu'ici nickel et encore merci à toi). Par contre admettant que je me sois trompé et que je sélectionne finalement en A3 "Lever assis", j'ai alors deux images superposées (celle du premier choix en dessous de celle du dernier choix).
Je souhaiterai que l'image de l'ancien choix s'efface, car si je me trompe souvent, mon document sera très lourd (car contenant beaucoup d'images)

Est ce que ce que je demande est réalisable sur 2007 ? (cela fonctionnait avec mon ancienne macro sur 2003)

Cordialement,

Romain

 

[Roland_M]

Re : Macro incompatible avec Excel 2007

re

je travaille sous 2003
et je fais des essais sur un ordi qui n'est pas à moi avec 2007
et je dois dire que c'est déconcertant !
2007 = Daube ! au risque de déplaire à certain !
car ce n'est pas la première fois que je suis confronté à ce manque d'incompatibilité ou avec des réactions complétement inattendues !
Microsoft. . . Bill. . . et toute sa clique, franchement ça devient pénible !
je finirai par passer chez Apple !

enfin bref !
c'était un peu mon coup de gueule du jour ! parceque ça commence à bien faire !
après tout, tous ces forums, sont bien là pour palier à toute cette daube Microsoft ! Compatibilté mon c..

je vais voir si je peux faire quelque chose !
rassures-toi tu n'y est pour rien !

 

[Roland_M]

Re : Macro incompatible avec Excel 2007

re

essai comme ceci !
ça a l'air de fonctionner sur 2003 et 2007 !?
tu me dis quoi !

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

' définit la cellule et supprime image dans cellule (même si nom=vide !)
Set MyCell = Target.Offset(0, 1): MyCell.Select
For Each Pict In ActiveSheet.Pictures
 If Pict.Left = MyCell.Left And Pict.Top = MyCell.Top Then Pict.Delete
Next
If Trim(Target.Value) > "" Then 'si un nom . . .
   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 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
End If
'fin sortie
Application.ScreenUpdating = True
On Error GoTo 0: Err.Clear
Exit Sub

ErrorHandler: 'traitement d'erreur
Dim Msg$
Application.ScreenUpdating = True
Msg = "Erreur " & Err.Source & "  No " & Err.Number & vbLf & vbLf & Err.Description
MsgBox Msg, vbCritical, "", Err.HelpFile, Err.HelpContext
On Error GoTo 0: Err.Clear
End Sub

 

[romain95]

Re : Macro incompatible avec Excel 2007

Salut Roland,

Je viens d'essayer ton code. C'est nickel!!!
Merci encore pour ton aide et tout le travail effectué.

Cordialement,

Romain

 

[romain95]

Re : Macro incompatible avec Excel 2007

Là je commence vraiment à croire que c'est plus possible. Y a 10 minutes, tout fonctionnait sur un de mes onglets et maintenant ça ne fonctionne plus alors que j'ai rien touché...

Sur un autre onglet, l'image ne se place plus dans la cellule d'à coté mais à l'intersection de la cellule du dessous en plus la dimension n'est pas la bonne et les images ne s'effacent pas quand la cellule est vide!!!

Dans un autre onglet, les images ne s'affichent plus du tout, mais là quand j'efface le contenu d'une cellule, l'effacement se réalise sur les images qui existaient avant que je colle cette nouvelle macro.

A n'y rien comprendre.

Une macro qui a des effets différents selon les onglets alors que le principe reste toujours le même!!!!

Si tu peux m'éclairer!

Cordialement,

Romain

 

[romain95]

Re : Macro incompatible avec Excel 2007

Alors après quelques tests, derniers constats :

- sur 1 onglet : les images n'apparaissent pas au bon endroit mais le remplacement de l'image selon le choix s'effectue et l'effacement de l'image quand ma cellule est vide s'effectue aussi

- sur l'autre onglet : effet inverse : les images apparaissent au bon endroit mais le remplacement de l'image selon le choix ne s'effectue pas (superposition) et l'effacement de l'image quand ma cellule est vide ne s'effectue pas aussi

Si ça peut t'orienter...

Cordialement,

Romain