Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Macro incompatible avec Excel 2007

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion romain95
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
R

romain95

XLDnaute Nouveau
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
 
Trier par date Trier par votes
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 !
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
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 !

Code: 
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
 
Vote positif 0 Vote négatif
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
 
Dernière édition:
Vote positif 0 Vote négatif
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 !
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Macro incompatible avec Excel 2007

re

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

Code: 
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
 
Dernière édition:
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

F
  • Question Question
Microsoft 365 Changement de fonctionnement d'une macro suite au passage à windows 10
Réponses
1
Affichages
566
francha62
F
  • Question Question
XL 2019 Fusionner jusqu'à dernière colonne contenant
Réponses
8
Affichages
931
TooFatBoy
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
2 K
Nicolas JACQUIN
C
  • Question Question
Microsoft 365 Impression PDF d'un Word via une macro Excel
Réponses
11
Affichages
1 K
job75
J
  • Question Question
Microsoft 365 Macro excel spécifier chemin de sauvegarde one drive
Réponses
4
Affichages
938
.jakob@gmail.com
J
M
  • Résolu(e)
XL 2019 Excel - générer .PDF avec envoie mail
Réponses
12
Affichages
2 K
Mika07
M
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
2 K
un internaute
U
O
  • Question Question
XL 2013 Publipostage avec pièce jointe via Excel
Réponses
1
Affichages
1 K
kiki29
R
  • Résolu(e)
XL 2016 Fusionner 3 classeurs Excel en un seul.
Réponses
10
Affichages
1 K
ReneDav14000
R
T
  • Question Question
XL 2016 besoin de votre aide pour adapté une macro
Réponses
6
Affichages
996
AtTheOne
C
  • Question Question
Microsoft 365 Convertir macro en script (faire marcher macro sur sharepoint)
Réponses
2
Affichages
3 K
crazy
C
R
  • Question Question
envoi mail avec pièce jointe
Réponses
1
Affichages
3 K
fanch55
T
  • Question Question
XL 2016 [VBA] problème macro EXCEL ne réponds pas
Réponses
11
Affichages
2 K
terry08200
T
B
  • Question Question
XL 2019 Macros renommer plusieurs feuilles de plusieurs fichiers Excel
Réponses
3
Affichages
2 K
Bastien43
B
B
  • Résolu(e)
XL 2019 Appliquer une macro à plusieurs fichiers d'un dossier - Débogage ?
Réponses
9
Affichages
1 K
Bastien43
B
K
  • Question Question
XL 2019 Extraction données avec filtre d'un fichier .txt sur Excel & créer nouveau fichier .txt
Réponses
1
Affichages
3 K
Hasco
Q
  • Question Question
Microsoft 365 Mise à jour planning
Réponses
4
Affichages
1 K
quent632
Q
P
  • Résolu(e)
XL 2019 Macro qui enregistre en PDF à personnaliser
Réponses
10
Affichages
2 K
pat66
P
  • Résolu(e)
Autres Excel 2007: Rang avec une macro dans une feuille de calcul
Réponses
3
Affichages
1 K
kkamadou
U
  • Question Question
Autres [RÉSOLU] Modification police copy avec macro
Réponses
9
Affichages
1 K
Staple1600
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…