Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
Bonsoir
Je ne sais plus si c'est possible ?
De récupérer l'adresse d'une cellule contenant une image si l'on clique dessus donc via la sub worksheets Selection_change et certainement l'intersect ?
Oui j'ai déjà vu ce post mais j'arrive pas à adapter car :
[c65536].End(3)(2) = s.TopLeftCell.Address ; Je pige pas ???
Ce que je retrouve pas c'est comment cliquer sur l'image et qui me donne l'adresse de la cellule contenant l'image? donc ici C5
Re , merci
Je démarre toujours mes Pb ...doucement
En fait je devrais avoir X images , ensuite selon le clic l'adresse de la cel . me permettra le traitement !!
Bon je fatigue ... Morphéé m'appelle !!!
MsgBox ActiveSheet.Shapes(1).TopLeftCell.Address 1 est la première image de la Feuille inséré. etc 2,3,4,5.... (Ranger par Ordre dans la feuille)
Ensuite si votre Image "Shapes(1)" s'appel "Image 1"
il faut substituer le 1 avec le nom de l'image soit : Shapes("Image 1") ' écrit en dur dans le code Application.Caller donne le nom de l'image est donc : Shapes(Application.Caller) ' écrit en variable dans le code
VB:
Sub image()
MsgBox ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address
End Sub
Bonjour @laurent950 : Merci bien pour tes explications , cela complète ce que je savais
Sinon , apparemment on ne sait pas traiter l'adresse comme en général , si on met Adr= ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address
je n'arrive pas à traiter Adr avec col & row ? ( comme avec Target adress)
Titre : Pour récupérer l'adresse d'une cellule contenant une Shape si l'on clique dessus.
Deux Modules :
- ThisWorkbook (Le Module de class du classeur Excel)
- EventsShapes (Un Module de class : renommé "EventsShapes")
Création d'un module de class pour rendre indépendant les événements qui sont liées à une feuille
- C'est a dire pour ne pas utiliser (les module de classe des feuilles du classeur Excel)
Le Principe
pour :
- ThisWorkbook (Dans ce Module)
des l'ouverture du classeur Excel :
Création d'une variable Objet du type application (Excel)
Instance de cette variable Objet
Création des liens (sur tous les shapes de la feuille active)
Code ci-dessous (A recopier dans ThisWorkbook)
VB:
Option Explicit
' Déclaration de variable privé de type application
Private xlApp As EventsShapes
'
Private Sub Workbook_Open()
' Instance de la variable de class à l'ouverture du classeur
' en Premier
Set xlApp = New EventsShapes
' Créations des liens sur les Shapes à l'ouverture du classeur
xlApp.CreatHyperLinks
End Sub
Pour :
- EventsShapes (dans ce module)
Deux Variables qui correspondent :
Private clsShp As Shape ' ................... Variable objet de type Shape
Private clsRgn As Range ' ................... Variable objet de type Range
La Variable WithEvents
Private WithEvents xlApp As Application ' ... Variable de la classe Application
Initialisation de la variable : avec Class_Initialize
Set xlApp = Application
- Lancement de la procédure a l'ouverture du classeur de la création de tous les liens hyperlien sur les shapes (de la feuille active)
Moyen pour déclencher l'événement change avec l'application (Excel)
- La procédure (qui a était personnalisé avec la classe pour lire les adresses de la shape selectionnée avec :
Private Sub xlApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
- Les deux variables clsShp & clsRgn ci-dessus pour lecture depuis cette class avec la Propriété : Property Get
Property Get Rgn() As Range
Property Get Shp() As Shape
Code ci-dessous (A recopier dans le module de classe créer est renommé "EventsShapes")
VB:
Option Explicit
' Pour le Module de classe
Private clsShp As Shape ' Variable objet de type Shape
Private clsRgn As Range ' Variable objet de type Range
Private WithEvents xlApp As Application ' Variable de la classe Application
'
Private Sub Class_Initialize()
Set xlApp = Application ' Instance de la Variable WithEvents de la class Application
End Sub
'
Private Sub xlApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim Flag As Boolean
On Error Resume Next
' Test si c'est bien une shape si non rien faire
' si c'est le Shape consignes les 2 objets
' Target qui est l'address active du Shape sélèctionné
' sh (n'est pas pris en charge avec l'action change sur le Shape
' Est l'objet Shape est identifié avec la boucle si dessous
Dim Objshape As Shape
For Each Objshape In Target.Worksheet.Shapes
' Si l'adress Target (de selection) Correspond avec l'adress du Shape
If Target.Address = Objshape.TopLeftCell.Address Then
Debug.Print Objshape.TopLeftCell.Address & "C'est l'address du Shape dans la Feuille Active)"
Set clsShp = Objshape ' Le Shape sélèctionné (Consigné dans le Module de Classe pour réutilisation ultérieur)
Set clsRgn = Target ' Le Range sélèctionné (Consigné dans le Module de Classe pour réutilisation ultérieur)
' si le Test est Vrai alors sortie de la boucle For
Flag = True
Exit For
End If
Next Objshape
'
If Flag = False Then
' Si le test est Faux alors :
' Decharge la variable (dans le module de class) si la selection ne correspond pas au shape
Set clsShp = Nothing
Set clsRgn = Nothing
End If
' Gestion d'erreur ci dessous (pour la collection et autre variable objet déjà vide)
On Error Resume Next
' Ci dessous exemple pour test
' Pour Test (Exemple)
MsgBox "Colonne : " & Me.Rgn.Column & " | " & "Ligne : " & Me.Rgn.Row ' col & row
MsgBox "Adresse : " & Me.Rgn.Address ' L'adresse
MsgBox "Name Shape : " & Me.Shp.Name ' Le nom du Shape
Me.Shp.Select ' Selection du shape
End Sub
'
Property Get Rgn() As Range
'' Lecture du Range sélèctionné (Consigné dans le Module de Classe pour réutilisation ultérieur)
Set Rgn = clsRgn
End Property
'
Property Get Shp() As Shape
' Lecture du Shape sélèctionné (Consigné dans le Module de Classe pour réutilisation ultérieur)
Set Shp = clsShp
End Property
'
Sub CreatHyperLinks()
' Création des hyperliens sur les Shapes de la Feuille active.
' Création à l'ouverture du classeur (Voir le Module ThisWookbook)
' Feuille (Active)
Dim FActive As Worksheet
' Création du lien (Sur les shapes de la feuilles actives)
Dim ObjHyplink As Hyperlink
Dim ObjHyplinks As Hyperlinks
' Les Objets Shapes de la "Feuille Active" pour création de lien de déclenchement dévénement"
Dim Objshape As Shape
Dim ObjRgn As Range
' La feuille Active
Set FActive = ActiveSheet
' Création de lien fictif sur l'image pour déclenchement de l'évement
For Each Objshape In FActive.Shapes
Debug.Print Objshape.Name ' Connaitre le Nom ds Shapes !
Debug.Print Objshape.TopLeftCell.Address ' Connaitre l'adresse ds Shapes !
' Pour Ajouter un hyperLiens a tous les Shapes de la feuille active
Set ObjHyplink = FActive.Hyperlinks.Add _
(Anchor:=Objshape, _
Address:="", _
SubAddress:="'" & FActive.Name & "'" & "!" & Objshape.TopLeftCell.Address(0, 0), _
ScreenTip:=CStr(Objshape.Name))
Next Objshape
End Sub
Nota : si vous créez des shapes sur une autre feuille, ou que le classeur s'ouvre sur une feuille qui n'a pas les Shape
Sélectionner la feuille active qui contient les shapes
Enregistrer et fermer le classeur
Une fois le classeur ouvert cela fonctionne
On peut créer d'autres événement comme par exemple au changement de feuille pour recréer les liens
exemple ci-dessous
Toujours dans le même module de classe ajouter ce code en complément
VB:
Private Sub xlApp_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' Création d'hyperLiens sur tous les shapes au changement de feuille (bien sur si il y a des shapes sur cette feuille créer)
CreatHyperLinks
End Sub
Je peux me tromper mais il me semble qu'herve62 ne cherche pas des choses compliquées :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim p As Object
For Each p In Pictures
p.OnAction = "Feuil1.Adr" 'affecte la macro
Next
End Sub
Sub Adr()
With Shapes(Application.Caller).TopLeftCell
MsgBox "Ligne " & .Row & vbLf & "Colonne " & Split(.Address, "$")(1), , "Adresse"
End With
End Sub
Bonsoir
Je reprends juste ; @laurent950 : c'est très bien ce que tu as fais , merci pour tout cela , mais comme le dit bien JOB , dans ce cas j'ai juste fait un petit prog pour un ami qui voulait en cliquant sur des photos dans une cellule
recopier des infos en rapport
Donc j'ai simplement fait une extraction de chaine ( 2 lignes ) pour avoir les 2 N° : col & row
C'est vrai que souvent je soumets des cas plus complexes , mais là non !!!
Vraiment Désolé pour le temps passé , car je me suis un peu précipité sur la fin sur une dernière question que j'ai résolu @job75 oui très succinct , je note et case dans mon grenier, car je ne maîtrise pas ce type d'instruction
Encore merci et à la prochaine !!!!
Votre code est très astucieux en Poste #9, je vous remercie aussi pour cette solution qui est très
souple et vraiment facile d'utilisation :
C'est votre solution à retenir en Poste "9
Ce site utilise des cookies pour personnaliser le contenu, adapter votre expérience et vous garder connecté si vous vous enregistrez.
En continuant à utiliser ce site, vous consentez à notre utilisation de cookies.