Bonsoir à tous ! je n'arrive pas à intégrer des lignes de code dans une macro.
Je n'y connais pas grand chose en vba et j'ai eu beau essayer de diverses manières rien n'y fait. Soit il ne se passe rien, soit j'ai un message "End if sans bloc If".
Voici la macro :
Private Sub Worksheet_Change(ByVal Target As Range)
'liens vers onglets
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range(Cells(7, 6), Cells(7, Columns.Count).End(xlToLeft))) Is Nothing And Not IsEmpty(Target) Then
Dim sh As Worksheet
On Error Resume Next
Set sh = Sheets(Target.Text)
If Not sh Is Nothing Then
Me.Hyperlinks.Add Anchor:=Target, Address:="", SubAddress:="'" & Target.Text & "'!A1", TextToDisplay:=Target.Text
End If
End If
'liens des listes verticales et horizontales
If Intersect(ActiveCell, Range("D6😀7")) Is Nothing Then Exit Sub
If Range("D6") = "" Or Range("D7") = "" Then Exit Sub
With Sheets("Parametres")
Set MaDate = .Range("A9:E65536").Find(CLng(.Range("D7").Value), LookIn:=xlValues, lookat:=xlWhole)
If MaDate Is Nothing Then Exit Sub Else lg = MaDate.Row
End With
col = Range("E5:IV5").Find(Range("D6").Value, LookIn:=xlValues, lookat:=xlWhole).Column
ActiveWindow.ScrollRow = lg
ActiveWindow.ScrollColumn = col
End Sub
et voici le code que j'aimerai y intégrer :
If Target.Address = "$D$4" Then
If [D4] = "Page 1" Then Sheets("Page 1").Select
End If
Merci d'avance
Cordialement
Frédéric
Je n'y connais pas grand chose en vba et j'ai eu beau essayer de diverses manières rien n'y fait. Soit il ne se passe rien, soit j'ai un message "End if sans bloc If".
Voici la macro :
Private Sub Worksheet_Change(ByVal Target As Range)
'liens vers onglets
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range(Cells(7, 6), Cells(7, Columns.Count).End(xlToLeft))) Is Nothing And Not IsEmpty(Target) Then
Dim sh As Worksheet
On Error Resume Next
Set sh = Sheets(Target.Text)
If Not sh Is Nothing Then
Me.Hyperlinks.Add Anchor:=Target, Address:="", SubAddress:="'" & Target.Text & "'!A1", TextToDisplay:=Target.Text
End If
End If
'liens des listes verticales et horizontales
If Intersect(ActiveCell, Range("D6😀7")) Is Nothing Then Exit Sub
If Range("D6") = "" Or Range("D7") = "" Then Exit Sub
With Sheets("Parametres")
Set MaDate = .Range("A9:E65536").Find(CLng(.Range("D7").Value), LookIn:=xlValues, lookat:=xlWhole)
If MaDate Is Nothing Then Exit Sub Else lg = MaDate.Row
End With
col = Range("E5:IV5").Find(Range("D6").Value, LookIn:=xlValues, lookat:=xlWhole).Column
ActiveWindow.ScrollRow = lg
ActiveWindow.ScrollColumn = col
End Sub
et voici le code que j'aimerai y intégrer :
If Target.Address = "$D$4" Then
If [D4] = "Page 1" Then Sheets("Page 1").Select
End If
Merci d'avance
Cordialement
Frédéric