besoin d aide macro hypertexte

[aksooll]

Bonjour tout le monde , je tourne en rond , je pensais avoir trouvé mais non
tout d abord, je tiens a dire que je suis en classeur en mode partager , donc certains trucs ne marchent plus

En VBA , je voudrais tout simplement que la personne qd elle écrive dans la cellule
si c est : du texte quelconque - ca fait rien
si c est écrit : C:\blabla\12.pptx , qu il ouvre le fichier qd clique droit ( ou double clique ) (ou créer un lien Hypertexte )

merci

 

[Staple1600]

Bonsoir le fil, le forum

@aksooll [Bienvenue sur le forum]
Pour sortir du rond

Private Sub Worksheet_Change(ByVal R As Range)
If R.Address = "$A$1" And Len(R) > 0 Then
If Dir(R.Text) > "" Then
ActiveWorkbook.FollowHyperlink R.Text, , True
Else
MsgBox "Fichier inexistant!", vbCritical, "ERREUR"
End If
End If
End Sub

NB: Code à mettre dans le code de la feuille
Chemin et nom du fichier à saisir dans cet exemple dans la cellule A1 puis valider par ENTER

 

[aksooll]

J ai essayer ca marche , mais
si je veux que ce soit de la section A1 a A10 uniquement je fais comment
deuxieme question , si j ouvre le lien et que je dis non , il me mets en mode erreur ( sous code VBA ) , pourquoi

 

[Staple1600]

Re

@aksooll

J ai essayer ca marche

Le contraire m'aurait étonné...
(en général, je teste mes codes VBA avant de les poster sur le forum )

 

[aksooll]

par contre j avais pas vu qu il ouvre le fichier direct, moi je voudrais qu il ouvre le fichier qd tu cliques par apres ( droit ou double ou autre )
et sinon pour le range , tu fais comment , car c sur la colonne L mon truc

 

[Staple1600]

Re

Comment tu fais?
1) Tu laisses éclater en toi ta curiosité (et tu cherches dans les archives du forum)
2) ou tu adaptes le code ci-dessous

Private Sub Worksheet_Change(ByVal R As Range)
If Not Intersect(R, Range("A1:A10")) Is Nothing Then
If R.Count > 1 Then Exit Sub
If Len(R) > 0 Then
If Dir(R.Text) > "" Then
ActiveWorkbook.FollowHyperlink R.Text, , True
Else
MsgBox "Fichier inexistant!", vbCritical, "ERREUR"
End If
End If
End If
End Sub

 

[aksooll]

c est ton truc avec un R que je comprends pas
la j ai mon code comme suit , peux tu juste m aider encore stp


If Not Intersect(Target, Range("L4:L40000")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
If Len(Target) > 0 Then
If Dir(Target.Text) > "" Then ActiveSheet.Hyperlinks.Add Anchor:=Target, Address:=Target.Value, TextToDisplay:=Target.Value
End If
End If

mais marche pas en mode partage ( ni ton code )

 

[Staple1600]

Re,

@aksooll
Il suffit de savoir lire...
Private Sub Worksheet_Change(ByVal R As Range)
Pour s'apercevoir que j'ai remplacé Target par R (R comme Range)
Donc soit on a R partout dans le code ou on a Target partout dans le code.

Sur ce je vais me coucher

 

[Paritec]

Bonjour Jm le forum
ah bah, s'il faut savoir lire maintenant !!!!! ou va-t'on !!!!
bon weekend
Papou

 

[Staple1600]

Bonjour le fil, le forum, aksooll, Paritec

@Paritec
Oui savoir lire ou prendre le temps de lire les messages et ses accotés peut éviter des quiproquos
Voila ce que certains XLDnautes peuvent lire sur mon profil [Section biographie]

Penche plutôt du côté de VBA, que des formules. Mais je me soigne.

[ATTENTION]
Pratique l'humour à froid et l'ironie mordante.
Envers autrui comme envers moi-même.

Quand je lis ceci

J ai essayer ca marche , mais

Et que je sais que j'ai posté un code où j'ai remplacé Target par R, j'en déduis que le demandeur l' a remarqué.
Intuition confirmée puisque ensuite, il a remplacé R par Target dans ses modifications
(sauf qu'il n'a pas fait le remplacement partout )

 

[aksooll]

juste pour partager un code que j ai reussi a faire , et qui marche surtout en MODE PARTAGE

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim MonApplication2 As Object
Dim MonFichier2 As String
If Intersect(Target, Range("L4:L40000")) Is Nothing Then Exit Sub
Cancel = True
Set MonApplication2 = CreateObject("Shell.Application")
MonFichier2 = Target.Value 'à remplacer par votre fichier
MonApplication2.Open (MonFichier2)

Set MonApplication2 = Nothing
Exit Sub

OuvertureFichierErreur:
Set MonApplication2 = Nothing
MsgBox "Erreur lors de l'ouverture de fichier..."
End Sub

 

[Staple1600]

Bonsoir le fil, le forum

aksooll
Merci pour ton feedback et pour avoir publier ta macro
Mais celle-ci n'a plus rien à voir avec le titre de ta discussion.
Dans ta macro, plus de trace d'HyperLink...

Sinon par curioisité et pour le fun, est-ce que ta macro ainsi écrite fonctionne également?

Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)
If Intersect(R, [L4:L40000]) Is Nothing Then Exit Sub
If Len(R) = 0 Then Exit Sub: Cancel = -1
CreateObject("Shell.Application").Open R.Text: R(2).Select: Exit Sub
End Sub

 

[aksooll]

oui ton code marche tres bien