MuscatMimi
XLDnaute Accro
Bonsoir a tous
je galère,je n'arrive pas a créer automatiquement un liens hypertext,dans la Colonne H,Feuil GestionMail
quand je valide mes données depuis Feuille MailEnvoyés,vers feuille GestionMail
a la validation la cellule de la colonne H contient le chemin complet vert le dossier
EX : H:\UsbSDF\Toyota\
Validation
Création Liens
Bonne soirée a tous
Merci a l'avance du coup de pouce
Christian
je galère,je n'arrive pas a créer automatiquement un liens hypertext,dans la Colonne H,Feuil GestionMail
quand je valide mes données depuis Feuille MailEnvoyés,vers feuille GestionMail
a la validation la cellule de la colonne H contient le chemin complet vert le dossier
EX : H:\UsbSDF\Toyota\
Validation
VB:
Sub Tst2()
Dim LastRow As Long
Dim WsDepart As Worksheet
Dim WsDestination As Worksheet
Set WsDestination = Sheets("GestionMail")
Set WsDepart = Sheets("MailEnvoyés")
LastRow = WsDestination.Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
WsDepart.Range("L6").Copy 'etat ok
WsDestination.Range("A" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("F2").Copy 'Date ok
WsDestination.Range("B" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("F4").Copy 'Objet
WsDestination.Range("C" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("D15").Copy 'a l'intention de
WsDestination.Range("D" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("F9").Copy 'mail desti
WsDestination.Range("E" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("F7").Copy 'donneur ordre
WsDestination.Range("F" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("I16").Copy 'mail desti
WsDestination.Range("G" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("I11").Copy 'donneur ordre
WsDestination.Range("H" & LastRow + 1).PasteSpecial xlPasteValues
WsDepart.Range("I11").Copy 'Nom chemin complet vers dossier noté dans Cellule I11
WsDestination.Range("H" & LastRow + 1).PasteSpecial xlPasteValues
Application.ScreenUpdating = False
Set WsDestination = Nothing
Set WsDepart = Nothing
End Sub
Création Liens
Code:
Sub les()
Dim Lien
Selection.End(xlDown).Select
fin = Selection.Row
For i = 2 To fin
Range("H" & i).Select
Lien = Range("H" & i).Value
If Lien = "" Then GoTo retour
Sheets("GestionMail").Hyperlinks.Add Anchor:=Selection, Address:=Lien
Next
retour:
End Sub
Bonne soirée a tous
Merci a l'avance du coup de pouce
Christian