T77XDD
XLDnaute Occasionnel
Bonjour,
je suis en mesure de rajouter un lien hypertexte à la fin de chaque ligne de la feuille:
Je cherche à rajouter
Dans le code suivant pour générer cet hyperlien à la fin de la ligne en cliquant sur le bouton "ImpEnr"
et pani rien à faire
Je tourne en rond depuis un moment les 2 séparément fonctionnent puis c'est tout, rien à faire (pour moi s'entend)
J'ai cherché dans les autres discussions, des bouquins y'a pas
Merci de tout ce que vous pourrez m'amener.
je suis en mesure de rajouter un lien hypertexte à la fin de chaque ligne de la feuille:
Code:
Option Explicit
Sub Hyperlien()
Dim Bat As String
Dim App As String
Dim Loc As String
Dim Ents As String
Dim DPnum As String
Dim Obj As String
Dim NomFichierPDF As String
Dim Filename As String
Dim i As Integer
With Sheets("Récap DP")
For i = 2 To .Range("A65535").End(xlUp).Row
Bat = .Range("H" & i)
App = .Range("G" & i)
Loc = .Range("I" & i)
Ents = .Range("O" & i)
DPnum = .Range("X" & i)
Obj = .Range("R" & i)
If Left(.Range("X" & i), 1) = "F" Then
'enr Fax
NomFichierPDF = "Fax" & " " & DPnum & " " & Obj & " " & Ents
Filename = "C:\DP\Fax\" & Ents & "\" & NomFichierPDF & ".pdf"
Else
'enr DP Parties communes
If App = "0" Then
NomFichierPDF = "DP" & " " & DPnum & " " & Loc & " " & Ents
Filename = "C:\DP\PartiesCommunes\" & Ents & "\" & NomFichierPDF & ".pdf"
Else
'enr DP Locataires
NomFichierPDF = "DP" & " " & DPnum & " " & Loc & " " & Ents
Filename = "C:\DP\" & Bat & "\" & App & "\" & NomFichierPDF & ".pdf"
End If
End If
ActiveCell.Hyperlinks.Add _
Anchor:=Range("Z" & i), _
Address:=Filename, _
TextToDisplay:=NomFichierPDF
Next i
End With
Code:
ActiveCell.Hyperlinks.Add _
Anchor = .Range("Z"), _
Address:=Filename, _
TextToDisplay:=NomFichierPDF
Code:
Option Explicit
Sub ImpEnrFaxDp()
If Left(ActiveCell, 1) = "F" Then
Selection.Copy
Sheets("FAX").Select
Range("I2").Select
ActiveSheet.Paste
Range("I3").Select
'With ActiveSheet
'.PageSetup.BlackAndWhite = True
'.PrintOut
'End With
Dim DPnum$, Bat$, App$, Loc$, Ents$, Obj$, Filename$, NomFichierPDF As String, derlig$, Tableau() As String
ActiveCell.CurrentRegion.Select
ReDim Tableau(1 To ActiveCell.CurrentRegion.Count)
DPnum = Sheets("FAX").Range("I1")
Ents = Sheets("FAX").Range("F14")
Obj = Sheets("FAX").Range("C25")
NomFichierPDF = "Fax" & " " & DPnum & " " & Obj & " " & Ents
Sheets("FAX").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\DP\Fax\" & Ents & "\" & NomFichierPDF & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Else
Selection.Copy
Sheets("DP").Select
Range("I2").Select
ActiveSheet.Paste
Range("I3").Select
'With ActiveSheet
'.PageSetup.BlackAndWhite = True
'.PrintOut
'End With
DPnum = Sheets("DP").Range("I1")
Bat = Sheets("DP").Range("C5")
App = Sheets("DP").Range("C7")
Loc = Sheets("DP").Range("C8")
Ents = Sheets("DP").Range("E8")
'enr DP PC
If App = "0" Then
NomFichierPDF = "DP" & " " & DPnum & " " & Loc & " " & Ents
Sheets("DP").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\DP\PartiesCommunes\" & Ents & "\" & NomFichierPDF & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Else
'enr PC Locataires
NomFichierPDF = "DP" & " " & DPnum & " " & Loc & " " & Ents
Sheets("DP").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\DP\" & Bat & "\" & App & "\" & NomFichierPDF & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
End If
ActiveCell.Hyperlinks.Add _
Anchor = .Range("Z"), _
Address:=Filename, _
TextToDisplay:=NomFichierPDF
Sheets("Récap DP").Select
derlig = [C65000].End(xlUp).Row + 1
Range(Cells(derlig, 1), Cells(derlig, 1)).Select
End Sub
Je tourne en rond depuis un moment les 2 séparément fonctionnent puis c'est tout, rien à faire (pour moi s'entend)
J'ai cherché dans les autres discussions, des bouquins y'a pas
Merci de tout ce que vous pourrez m'amener.
Dernière édition: