Liens hypertextes dynamiques et formes
Bonsoir,
J'ai inséré des plans dans un fichier excel où sont recensées des serrures de porte.
Dans la feuille base de données en colonne A, une forme rectangle transparente, amène (par macro) vers une autre "shape" de la feuille nommée "RDC". Le rectangle de destination change de couleur pour mieux être localisé.
Dans la feuille base de données, les informations en colonne A, peuvent occasionnellement monter ou descendre d'une ligne.
J'ai inséré un lien hypertexte manuellement sur chaque forme. Est-il possible de rendre ce lien hypertexte dynamique pour que le rectangle sélectionné soit toujours attaché à la cellule portant la même valeur (texte)?
Une autre question. Est-il possible de sélectionner une forme (rectangle par exemple) selon le texte qui y est inséré à l'intérieur?
Merci pour l'aide que vous pourrez m'apporter.
Pour la première question, j'ai utilisé testé l'enregistreur de macro. Il y a certainement mieux mais cela fonctionne.
Exemple :
Sub Macro2()
On Error GoTo SUITE
Sheets("Base de données").Select
Cells.Find(What:="6C", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _
:=False, SearchFormat:=False).Activate
SUITE:
Exit Sub
End Sub
Merci Jean-Eric, c'est génial. Une seule macro au lieu de 300 et quelques macros individuelles. Cela me fait gagner beaucoup de temps.
Serait-il possible d'adapter la macro ci-après pour que le principe fonctionne dans les deux sens :
La macro prendrait alors en compte, la valeur de la forme l'ayant lancée, pour trouver la forme de destination. Cela me permettrait également de n'utiliser qu'une seule macro.
Exemple :
Sub A006F()
Range("A43").Select 'Forme d'où est lancée la macro[/color]
Dim rStart As Range
Dim shp As Shape
Dim sFind As String
Dim sTemp As String
sFind = ActiveCell.Value 'Valeur de la forme lançant la macro
Set rStart = ActiveCell
Sheets(4).Select
For Each shp In ActiveSheet.Shapes
sTemp = shp.TextFrame.Characters.Text
If InStr(LCase(sTemp), LCase(sFind)) <> 0 Then
shp.Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0.5099999905
.Solid
End With
Call Unselectshapes
End If
Next
End Sub
J'ai avancé dans ma recherche, la macro ci-après fonctionne.
Pourriez-vous me préciser s'il est possible d'exécuter cette macro sur plusieurs feuilles (sauf la première) sans qu'elles soient sélectionnées afin de ne pas compromettre les macros évènementielles :
Sub TestA()
Dim i As Integer
Dim rStart As Range
Dim shp As Shape
Dim sFind As String
Dim sTemp As String
Dim st As String
sFind = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
Sheets(4).Select 'Permettre l'exploitation de cette macro sur tout le classeur sauf la première feuille
For Each shp In ActiveSheet.Shapes
If shp.Name <> "dudu" Then 'L'image de fond (plan absent de mon fichier exemple) est exclue pour ne pas générer d'erreur.
sTemp = shp.TextFrame.Characters.Text
If InStr(LCase(sTemp), LCase(sFind)) <> 0 Then
shp.Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0.5099999905
.Solid
End With
Call Unselectshapes
End If
End If
Next
End Sub
Je n'ai pas trouvé de la solution qui aplliquerait la macro ci-desus à l'ensemble des feuilles du classeur.
Pour ceux que cela intéresse, j'ai utilisé la macro ci-après pour que la forme que je sélectionne prenne la valeur (le texte pas le nom de la forme) de la cellule active de mon choix.
Sub ValeurCelluleActive()
Dim ActiveShape As Shape
Dim UserSelection As Variant
Set UserSelection = ActiveWindow.Selection
On Error GoTo SUITE
Set ActiveShape = ActiveSheet.Shapes(UserSelection.Name)
ActiveShape.TextFrame.Characters.Text = ActiveCell.Offset(0, 0).Value
SUITE:
Exit Sub
End Sub