Problème dans une macro

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Barbapapa

XLDnaute Occasionnel
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
 
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
 
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
 
Re : Problème dans une macro

Bonjour Barbapapa, perpitou, jpb388,

Essaie comme ceci :

Code:
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 :

Code:
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.
 
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+
 
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
 
Re : Problème dans une macro

Bonjour Barbapapa,

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

Voici donc comment modifier la macro :

Code:
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.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
252
  • Question Question
Microsoft 365 Probléme VBA
Réponses
8
Affichages
234
Réponses
4
Affichages
363
Réponses
1
Affichages
323
Retour