Problème dans une macro

[Barbapapa]

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("D67")) 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

 

[perpitou]

Re : Problème dans une macro

If Target.Address = "$D$4" Then
If [D4] = "Page 1" Then Sheets("Page 1").Select
End If
End If

Et c'est bon!

 

[Barbapapa]

Re : Problème dans une macro

Bonsoir Perpitou, j'ai déja essayé... ça me met "erreur de comilation : End If sans bloc If"
Je ne sais pas où l'intégrer exactement à l'intérieur de toutes ces lignes de code (au début, à la fin...) pour que cela fonctionne.
A + et merci

 

[jpb388]

Re : Problème dans une macro

Bonjour a tous
je pense ici

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("D67")) 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
If Target.Address = "$D$4" Then
If [D4] = "Page 1" Then Sheets("Page 1").Select
End If
End Sub

 

[Barbapapa]

Re : Problème dans une macro

Merci JP, mais ça ne fonctionne pas... il ne se passe plus rien comme cela.
J'essaye un peu tout mais sans succès.
A+

 

[Papou-net]

Re : Problème dans une macro

Bonjour Barbapapa, perpitou, jpb388,

Essaie comme ceci :

If Target.Address = "$D$4" And Target.Value = "Page 1" Then Sheets(Target.Value).Activate

Par contre, vérifie bien que la syntaxe "Page 1" est la bonne : y a-t-il réellement un espace ?

Tu peux également essayer comme ceci :

If Target.Address = "$D$4" And Target.Value = Sheets(1).Name Then Sheets(1).Activate

En remplaçant le (1)par l'index de la feuille concernée.

Il eût été plus simple de te répondre avec ton fichier sous les yeux.

Cordialement.

 

[jpb388]

Re : Problème dans une macro

bonjour a tous

comme le dit Papou-net met ton fichier ou un exemple très représentatif avec des explications précises de ce que tu veux et pourquoi faire ainsi on pourra peut être déterminer à quel moment il faut mettre tes lignes
a+

 

[Barbapapa]

Re : Problème dans une macro

Bonjour Papou-net et JP, merci à vous.
J'ai mis un fichier pour plus de facilité.
Bonne journée et meric
Frédéric

 

[Papou-net]

Re : Problème dans une macro

Re Barbapapa,

Ci-joint ton fichier modifié.

Espérant avoir compris la question.

Cordialement.

 

[Barbapapa]

Re : Problème dans une macro

Bonsoir Papou-net, et merci de vous occuper une fois de plus de moi.
Je n'ai pas dû être très clair dans mon explication et j'en suis désolé;
En fait, les cellules b2 et b4 me permettent de faire une recherche dans la feuille où les volets sont figés, elle sont en quelque sorte liées. b2 sert à faire bouger la feuille horizontalement et b4 à faire bouger la feuille verticalement avec les dates.
Ce que j'aimerai c'est que en b1, la cellule soit indépendante de b2 et b4 et, et que à l'aide de la liste déroulante qu'elle contient on puisse ouvrir les feuilles 2 et 3.
J'espère que mon explication est claire, ce n'est pas toujours évident d'expliquer les choses.
Merci encore et bonne soirée
Frédéric

 

[Papou-net]

Re : Problème dans une macro

Bonjour Barbapapa,

Alors effectivement, à question plus nette réponse plus précise.

Voici donc comment modifier la macro :

Private Sub Worksheet_Change(ByVal Target As Range)
'liens vers onglets
If Target.Count > 1 Then Exit Sub
' ----------------------------------------------
If Target.Address = "$B$1" Then
  Sheets(Range("B1").Value).Activate
  Exit Sub
End If
' ----------------------------------------------
If Not Intersect(Target, Range(Cells(2, 4), Cells(2, 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
If Intersect(ActiveCell, Range("B2:B4")) Is Nothing Then Exit Sub
If Range("B2") = "" Or Range("B4") = "" Then Exit Sub
With Sheets("listes")
  Set MaDate = .Range("B5:B65536").Find(CLng(.Range("B4").Value), LookIn:=xlValues, lookat:=xlWhole)
  If MaDate Is Nothing Then Exit Sub Else lg = MaDate.Row
End With
col = Range("C1:IV1").Find(Range("B2").Value, LookIn:=xlValues, lookat:=xlWhole).Column
ActiveWindow.ScrollRow = lg
ActiveWindow.ScrollColumn = col

End Sub

Espérant avoir répondu.

Bonne journée.

Cordialement.

 

[Barbapapa]

Re : Problème dans une macro

Bonjour, Papou-net, je vous remercie encore une fois pour votre gentillesse et votre savoir faire.
Tout fonctionne comme je l'espérais.
Je vous souhaite une très bonne journée.
Cordialement
Frédéric