Bonjour Je souhaite que lorsque je clique dans un élément de la liste cela m'envoie sur la page en question Merci
Quelle Liste ??? Personelle, fichiers, onglets, images, sons Quelle type de page ??? URL, Excel, Word ,PPT
les bénévoles ne sont pas des devins... SVP, précisez le contexte et les besoins @+
-- http://viadresse.com/?94912042
Lionel B
Euh... Désolé J'ai des noms dans ma listbox, je souhaite qu'en cliquant sur le nom, cela m'envoie sur la page en question Ex : si je clique sur toto, cela m'envoie sur la feuille qui se nomme toto Merci
"Modeste" a écrit dans le message de news: %
Bonsour® Lionel B wrote:
Bonjour Je souhaite que lorsque je clique dans un élément de la liste cela m'envoie sur la page en question Merci
Quelle Liste ??? Personelle, fichiers, onglets, images, sons Quelle type de page ??? URL, Excel, Word ,PPT
les bénévoles ne sont pas des devins... SVP, précisez le contexte et les besoins @+
-- http://viadresse.com/?94912042
Euh...
Désolé
J'ai des noms dans ma listbox, je souhaite qu'en cliquant sur le nom, cela
m'envoie sur la page en question
Ex : si je clique sur toto, cela m'envoie sur la feuille qui se nomme toto
Merci
"Modeste" <nomail@nomail.net> a écrit dans le message de news:
%23OZ4OU3jFHA.1412@TK2MSFTNGP09.phx.gbl...
Bonsour®
Lionel B wrote:
Bonjour
Je souhaite que lorsque je clique dans un élément de la liste
cela m'envoie sur la page en question
Merci
Quelle Liste ??? Personelle, fichiers, onglets, images, sons
Quelle type de page ??? URL, Excel, Word ,PPT
les bénévoles ne sont pas des devins...
SVP, précisez le contexte et les besoins
@+
Euh... Désolé J'ai des noms dans ma listbox, je souhaite qu'en cliquant sur le nom, cela m'envoie sur la page en question Ex : si je clique sur toto, cela m'envoie sur la feuille qui se nomme toto Merci
"Modeste" a écrit dans le message de news: %
Bonsour® Lionel B wrote:
Bonjour Je souhaite que lorsque je clique dans un élément de la liste cela m'envoie sur la page en question Merci
Quelle Liste ??? Personelle, fichiers, onglets, images, sons Quelle type de page ??? URL, Excel, Word ,PPT
les bénévoles ne sont pas des devins... SVP, précisez le contexte et les besoins @+
-- http://viadresse.com/?94912042
Modeste
Bonsour® Lionel B je te conseillerai de jeter un oeil là : http://perso.wanadoo.fr/frederic.sigonneau/code/ToutFait/FeuillesClasseurs.zip
@+
-- http://viadresse.com/?94912042
Bonsour® Lionel B
je te conseillerai de jeter un oeil là :
http://perso.wanadoo.fr/frederic.sigonneau/code/ToutFait/FeuillesClasseurs.zip
Bonsour® Lionel B je te conseillerai de jeter un oeil là : http://perso.wanadoo.fr/frederic.sigonneau/code/ToutFait/FeuillesClasseurs.zip
@+
-- http://viadresse.com/?94912042
Frédo P
Bonjour LionelB Une solution parmi d'autre, je n'en ai pas laisser beaucoup à faire, seulement la création d'un bouton pour le retour vers la feuille "Menu" à placer sur chaque feuille. Il te faut en premier lieu créer ta feuille du menu ,Inscrire "Menu" en gros sur la première ligne de la colonne B, coller dans le code de feuille les deux proc suivantes. Tu pourras ajouter en colonne C une courte explication de l'objet feuille.
Private Sub Worksheet_Activate() On Error GoTo gesterr Dim ws As Worksheet, Fin As Integer Detabl Fin = Range("B65536").End(3).Row For Each ws In ThisWorkbook.Worksheets If IsError(Application.Match(ws.Name, Range("B1:B" & Fin), 0)) Then Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone Range("B" & Fin + 1).Font.Bold = True Range("B" & Fin + 1) = ws.Name Rows(Fin).AutoFit End If Next Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone ActiveSheet.ScrollArea = "A1:D" & Fin + 2 Range("B" & [B10:B34].Find("", LookIn:=xlValues).Row).Select gesterr: Retabl End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) On Error GoTo gest Dim Sht As String Detabl Sht= Cells(ActiveCell.Row, 2).Value If Sht <> "" Then If Sht = "Quitter" Then Workbooks.Close End If Sheets(Sht).Activate End If 'en suposant que ta feuille servant de menu se nomme Menu, (à adapter) Sheets("Menu").Range("B1:B65536").Find("", LookIn:=xlValues).Rows.Select ' en espérant que tu n'ailles pas jusque la 65536 ième gest: Retabl End Sub
à mettre dans un module Sub Detabl() Application.ScreenUpdating = False Application.EnableEvents = False End Sub
Sub Retabl() Application.EnableEvents = True Application.ScreenUpdating = True End Sub -- En éspérant n'avoir rien oublié Fred Pour répondre, ôtez "nsp"
Bonjour LionelB
Une solution parmi d'autre, je n'en ai pas laisser beaucoup à faire,
seulement la création d'un bouton pour le retour vers la feuille "Menu" à
placer sur chaque feuille.
Il te faut en premier lieu créer ta feuille du menu ,Inscrire "Menu" en gros
sur la première ligne de la colonne B, coller dans le code de feuille les
deux proc suivantes.
Tu pourras ajouter en colonne C une courte explication de l'objet feuille.
Private Sub Worksheet_Activate()
On Error GoTo gesterr
Dim ws As Worksheet, Fin As Integer
Detabl
Fin = Range("B65536").End(3).Row
For Each ws In ThisWorkbook.Worksheets
If IsError(Application.Match(ws.Name, Range("B1:B" & Fin), 0)) Then
Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone
Range("B" & Fin + 1).Font.Bold = True
Range("B" & Fin + 1) = ws.Name
Rows(Fin).AutoFit
End If
Next
Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone
ActiveSheet.ScrollArea = "A1:D" & Fin + 2
Range("B" & [B10:B34].Find("", LookIn:=xlValues).Row).Select
gesterr:
Retabl
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
On Error GoTo gest
Dim Sht As String
Detabl
Sht= Cells(ActiveCell.Row, 2).Value
If Sht <> "" Then
If Sht = "Quitter" Then
Workbooks.Close
End If
Sheets(Sht).Activate
End If
'en suposant que ta feuille servant de menu se nomme Menu, (à adapter)
Sheets("Menu").Range("B1:B65536").Find("", LookIn:=xlValues).Rows.Select '
en espérant que tu n'ailles pas jusque la 65536 ième
gest:
Retabl
End Sub
à mettre dans un module
Sub Detabl()
Application.ScreenUpdating = False
Application.EnableEvents = False
End Sub
Sub Retabl()
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
--
En éspérant n'avoir rien oublié
Fred
Pour répondre, ôtez "nsp"
Bonjour LionelB Une solution parmi d'autre, je n'en ai pas laisser beaucoup à faire, seulement la création d'un bouton pour le retour vers la feuille "Menu" à placer sur chaque feuille. Il te faut en premier lieu créer ta feuille du menu ,Inscrire "Menu" en gros sur la première ligne de la colonne B, coller dans le code de feuille les deux proc suivantes. Tu pourras ajouter en colonne C une courte explication de l'objet feuille.
Private Sub Worksheet_Activate() On Error GoTo gesterr Dim ws As Worksheet, Fin As Integer Detabl Fin = Range("B65536").End(3).Row For Each ws In ThisWorkbook.Worksheets If IsError(Application.Match(ws.Name, Range("B1:B" & Fin), 0)) Then Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone Range("B" & Fin + 1).Font.Bold = True Range("B" & Fin + 1) = ws.Name Rows(Fin).AutoFit End If Next Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone ActiveSheet.ScrollArea = "A1:D" & Fin + 2 Range("B" & [B10:B34].Find("", LookIn:=xlValues).Row).Select gesterr: Retabl End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) On Error GoTo gest Dim Sht As String Detabl Sht= Cells(ActiveCell.Row, 2).Value If Sht <> "" Then If Sht = "Quitter" Then Workbooks.Close End If Sheets(Sht).Activate End If 'en suposant que ta feuille servant de menu se nomme Menu, (à adapter) Sheets("Menu").Range("B1:B65536").Find("", LookIn:=xlValues).Rows.Select ' en espérant que tu n'ailles pas jusque la 65536 ième gest: Retabl End Sub
à mettre dans un module Sub Detabl() Application.ScreenUpdating = False Application.EnableEvents = False End Sub
Sub Retabl() Application.EnableEvents = True Application.ScreenUpdating = True End Sub -- En éspérant n'avoir rien oublié Fred Pour répondre, ôtez "nsp"
Lionel B
Je te remercie beaucoup LB
"Frédo P" a écrit dans le message de news: %
Bonjour LionelB Une solution parmi d'autre, je n'en ai pas laisser beaucoup à faire, seulement la création d'un bouton pour le retour vers la feuille "Menu" à placer sur chaque feuille. Il te faut en premier lieu créer ta feuille du menu ,Inscrire "Menu" en gros sur la première ligne de la colonne B, coller dans le code de feuille les deux proc suivantes. Tu pourras ajouter en colonne C une courte explication de l'objet feuille.
Private Sub Worksheet_Activate() On Error GoTo gesterr Dim ws As Worksheet, Fin As Integer Detabl Fin = Range("B65536").End(3).Row For Each ws In ThisWorkbook.Worksheets If IsError(Application.Match(ws.Name, Range("B1:B" & Fin), 0)) Then Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone Range("B" & Fin + 1).Font.Bold = True Range("B" & Fin + 1) = ws.Name Rows(Fin).AutoFit End If Next Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone ActiveSheet.ScrollArea = "A1:D" & Fin + 2 Range("B" & [B10:B34].Find("", LookIn:=xlValues).Row).Select gesterr: Retabl End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) On Error GoTo gest Dim Sht As String Detabl Sht= Cells(ActiveCell.Row, 2).Value If Sht <> "" Then If Sht = "Quitter" Then Workbooks.Close End If Sheets(Sht).Activate End If 'en suposant que ta feuille servant de menu se nomme Menu, (à adapter) Sheets("Menu").Range("B1:B65536").Find("", LookIn:=xlValues).Rows.Select ' en espérant que tu n'ailles pas jusque la 65536 ième gest: Retabl End Sub
à mettre dans un module Sub Detabl() Application.ScreenUpdating = False Application.EnableEvents = False End Sub
Sub Retabl() Application.EnableEvents = True Application.ScreenUpdating = True End Sub -- En éspérant n'avoir rien oublié Fred Pour répondre, ôtez "nsp"
Je te remercie beaucoup
LB
"Frédo P" <nspfrdpst@9online.fr> a écrit dans le message de news:
%23NLOoiFkFHA.3736@TK2MSFTNGP10.phx.gbl...
Bonjour LionelB
Une solution parmi d'autre, je n'en ai pas laisser beaucoup à faire,
seulement la création d'un bouton pour le retour vers la feuille "Menu" à
placer sur chaque feuille.
Il te faut en premier lieu créer ta feuille du menu ,Inscrire "Menu" en
gros
sur la première ligne de la colonne B, coller dans le code de feuille les
deux proc suivantes.
Tu pourras ajouter en colonne C une courte explication de l'objet feuille.
Private Sub Worksheet_Activate()
On Error GoTo gesterr
Dim ws As Worksheet, Fin As Integer
Detabl
Fin = Range("B65536").End(3).Row
For Each ws In ThisWorkbook.Worksheets
If IsError(Application.Match(ws.Name, Range("B1:B" & Fin), 0)) Then
Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone
Range("B" & Fin + 1).Font.Bold = True
Range("B" & Fin + 1) = ws.Name
Rows(Fin).AutoFit
End If
Next
Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone
ActiveSheet.ScrollArea = "A1:D" & Fin + 2
Range("B" & [B10:B34].Find("", LookIn:=xlValues).Row).Select
gesterr:
Retabl
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
On Error GoTo gest
Dim Sht As String
Detabl
Sht= Cells(ActiveCell.Row, 2).Value
If Sht <> "" Then
If Sht = "Quitter" Then
Workbooks.Close
End If
Sheets(Sht).Activate
End If
'en suposant que ta feuille servant de menu se nomme Menu, (à adapter)
Sheets("Menu").Range("B1:B65536").Find("", LookIn:=xlValues).Rows.Select '
en espérant que tu n'ailles pas jusque la 65536 ième
gest:
Retabl
End Sub
à mettre dans un module
Sub Detabl()
Application.ScreenUpdating = False
Application.EnableEvents = False
End Sub
Sub Retabl()
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
--
En éspérant n'avoir rien oublié
Fred
Pour répondre, ôtez "nsp"
Bonjour LionelB Une solution parmi d'autre, je n'en ai pas laisser beaucoup à faire, seulement la création d'un bouton pour le retour vers la feuille "Menu" à placer sur chaque feuille. Il te faut en premier lieu créer ta feuille du menu ,Inscrire "Menu" en gros sur la première ligne de la colonne B, coller dans le code de feuille les deux proc suivantes. Tu pourras ajouter en colonne C une courte explication de l'objet feuille.
Private Sub Worksheet_Activate() On Error GoTo gesterr Dim ws As Worksheet, Fin As Integer Detabl Fin = Range("B65536").End(3).Row For Each ws In ThisWorkbook.Worksheets If IsError(Application.Match(ws.Name, Range("B1:B" & Fin), 0)) Then Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone Range("B" & Fin + 1).Font.Bold = True Range("B" & Fin + 1) = ws.Name Rows(Fin).AutoFit End If Next Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone ActiveSheet.ScrollArea = "A1:D" & Fin + 2 Range("B" & [B10:B34].Find("", LookIn:=xlValues).Row).Select gesterr: Retabl End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) On Error GoTo gest Dim Sht As String Detabl Sht= Cells(ActiveCell.Row, 2).Value If Sht <> "" Then If Sht = "Quitter" Then Workbooks.Close End If Sheets(Sht).Activate End If 'en suposant que ta feuille servant de menu se nomme Menu, (à adapter) Sheets("Menu").Range("B1:B65536").Find("", LookIn:=xlValues).Rows.Select ' en espérant que tu n'ailles pas jusque la 65536 ième gest: Retabl End Sub
à mettre dans un module Sub Detabl() Application.ScreenUpdating = False Application.EnableEvents = False End Sub
Sub Retabl() Application.EnableEvents = True Application.ScreenUpdating = True End Sub -- En éspérant n'avoir rien oublié Fred Pour répondre, ôtez "nsp"
Frédo P
Bonjour Lionelb En supposant que tout fonctionne, La proc " Private Sub Worksheet_Activate()" peut être supprimée si il n'y a plus de nouvelle feuille à créer. "
-- Fred Pour répondre, ôtez "nsp"
"Lionel B" a écrit dans le message de news: OBnb#
Je te remercie beaucoup LB
"Frédo P" a écrit dans le message de news: %
Bonjour LionelB Une solution parmi d'autre, je n'en ai pas laisser beaucoup à faire, seulement la création d'un bouton pour le retour vers la feuille "Menu" à
placer sur chaque feuille. Il te faut en premier lieu créer ta feuille du menu ,Inscrire "Menu" en gros sur la première ligne de la colonne B, coller dans le code de feuille les
deux proc suivantes. Tu pourras ajouter en colonne C une courte explication de l'objet feuille.
Private Sub Worksheet_Activate() On Error GoTo gesterr Dim ws As Worksheet, Fin As Integer Detabl Fin = Range("B65536").End(3).Row For Each ws In ThisWorkbook.Worksheets If IsError(Application.Match(ws.Name, Range("B1:B" & Fin), 0)) Then Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex xlNone Range("B" & Fin + 1).Font.Bold = True Range("B" & Fin + 1) = ws.Name Rows(Fin).AutoFit End If Next Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone ActiveSheet.ScrollArea = "A1:D" & Fin + 2 Range("B" & [B10:B34].Find("", LookIn:=xlValues).Row).Select gesterr: Retabl End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) On Error GoTo gest Dim Sht As String Detabl Sht= Cells(ActiveCell.Row, 2).Value If Sht <> "" Then If Sht = "Quitter" Then Workbooks.Close End If Sheets(Sht).Activate End If 'en suposant que ta feuille servant de menu se nomme Menu, (à adapter) Sheets("Menu").Range("B1:B65536").Find("", LookIn:=xlValues).Rows.Select '
en espérant que tu n'ailles pas jusque la 65536 ième gest: Retabl End Sub
à mettre dans un module Sub Detabl() Application.ScreenUpdating = False Application.EnableEvents = False End Sub
Sub Retabl() Application.EnableEvents = True Application.ScreenUpdating = True End Sub -- En éspérant n'avoir rien oublié Fred Pour répondre, ôtez "nsp"
Bonjour Lionelb
En supposant que tout fonctionne, La proc " Private Sub
Worksheet_Activate()" peut être supprimée si il n'y a plus de nouvelle
feuille à créer.
"
--
Fred
Pour répondre, ôtez "nsp"
"Lionel B" <Lionel@club-internet.fr> a écrit dans le message de news:
OBnb#pGkFHA.2444@tk2msftngp13.phx.gbl...
Je te remercie beaucoup
LB
"Frédo P" <nspfrdpst@9online.fr> a écrit dans le message de news:
%23NLOoiFkFHA.3736@TK2MSFTNGP10.phx.gbl...
Bonjour LionelB
Une solution parmi d'autre, je n'en ai pas laisser beaucoup à faire,
seulement la création d'un bouton pour le retour vers la feuille "Menu"
à
placer sur chaque feuille.
Il te faut en premier lieu créer ta feuille du menu ,Inscrire "Menu" en
gros
sur la première ligne de la colonne B, coller dans le code de feuille
les
deux proc suivantes.
Tu pourras ajouter en colonne C une courte explication de l'objet
feuille.
Private Sub Worksheet_Activate()
On Error GoTo gesterr
Dim ws As Worksheet, Fin As Integer
Detabl
Fin = Range("B65536").End(3).Row
For Each ws In ThisWorkbook.Worksheets
If IsError(Application.Match(ws.Name, Range("B1:B" & Fin), 0)) Then
Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex xlNone
Range("B" & Fin + 1).Font.Bold = True
Range("B" & Fin + 1) = ws.Name
Rows(Fin).AutoFit
End If
Next
Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone
ActiveSheet.ScrollArea = "A1:D" & Fin + 2
Range("B" & [B10:B34].Find("", LookIn:=xlValues).Row).Select
gesterr:
Retabl
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
On Error GoTo gest
Dim Sht As String
Detabl
Sht= Cells(ActiveCell.Row, 2).Value
If Sht <> "" Then
If Sht = "Quitter" Then
Workbooks.Close
End If
Sheets(Sht).Activate
End If
'en suposant que ta feuille servant de menu se nomme Menu, (à adapter)
Sheets("Menu").Range("B1:B65536").Find("", LookIn:=xlValues).Rows.Select
'
en espérant que tu n'ailles pas jusque la 65536 ième
gest:
Retabl
End Sub
à mettre dans un module
Sub Detabl()
Application.ScreenUpdating = False
Application.EnableEvents = False
End Sub
Sub Retabl()
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
--
En éspérant n'avoir rien oublié
Fred
Pour répondre, ôtez "nsp"
Bonjour Lionelb En supposant que tout fonctionne, La proc " Private Sub Worksheet_Activate()" peut être supprimée si il n'y a plus de nouvelle feuille à créer. "
-- Fred Pour répondre, ôtez "nsp"
"Lionel B" a écrit dans le message de news: OBnb#
Je te remercie beaucoup LB
"Frédo P" a écrit dans le message de news: %
Bonjour LionelB Une solution parmi d'autre, je n'en ai pas laisser beaucoup à faire, seulement la création d'un bouton pour le retour vers la feuille "Menu" à
placer sur chaque feuille. Il te faut en premier lieu créer ta feuille du menu ,Inscrire "Menu" en gros sur la première ligne de la colonne B, coller dans le code de feuille les
deux proc suivantes. Tu pourras ajouter en colonne C une courte explication de l'objet feuille.
Private Sub Worksheet_Activate() On Error GoTo gesterr Dim ws As Worksheet, Fin As Integer Detabl Fin = Range("B65536").End(3).Row For Each ws In ThisWorkbook.Worksheets If IsError(Application.Match(ws.Name, Range("B1:B" & Fin), 0)) Then Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex xlNone Range("B" & Fin + 1).Font.Bold = True Range("B" & Fin + 1) = ws.Name Rows(Fin).AutoFit End If Next Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone ActiveSheet.ScrollArea = "A1:D" & Fin + 2 Range("B" & [B10:B34].Find("", LookIn:=xlValues).Row).Select gesterr: Retabl End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) On Error GoTo gest Dim Sht As String Detabl Sht= Cells(ActiveCell.Row, 2).Value If Sht <> "" Then If Sht = "Quitter" Then Workbooks.Close End If Sheets(Sht).Activate End If 'en suposant que ta feuille servant de menu se nomme Menu, (à adapter) Sheets("Menu").Range("B1:B65536").Find("", LookIn:=xlValues).Rows.Select '
en espérant que tu n'ailles pas jusque la 65536 ième gest: Retabl End Sub
à mettre dans un module Sub Detabl() Application.ScreenUpdating = False Application.EnableEvents = False End Sub
Sub Retabl() Application.EnableEvents = True Application.ScreenUpdating = True End Sub -- En éspérant n'avoir rien oublié Fred Pour répondre, ôtez "nsp"
Frédo P
"Bonjour LionelB La proc. est sans erreur cette fois. Je retiens ton attention sur le fait que si cette procédure ,pour une raison quelconque, est interrompue en son milieu, il faudra absolument démarrer manuellement la procédure "Retabl" ou mettre "Application.EnableEvents" à True.(Application.EnableEvents = True).
Private Sub Worksheet_Activate() On Error GoTo gesterr Dim ws As Worksheet, Fin As Integer Detabl Fin = Range("B65536").End(3).Row For Each ws In ThisWorkbook.Worksheets If IsError(Application.Match(ws.Name, Range("B1:B" & Fin), 0)) Then Fin = Range("B65536").End(3).Row Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone Range("B" & Fin + 1).Font.Bold = True Range("B" & Fin + 1) = ws.Name Rows(Fin).AutoFit End If Next Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone ActiveSheet.ScrollArea = "A1:D" & Fin + 2 Range("B" & [B10:B34].Find("", LookIn:=xlValues).Row).Select gesterr: Retabl End Sub
Fred Pour répondre, ôtez "nsp"
"Bonjour LionelB
La proc. est sans erreur cette fois.
Je retiens ton attention sur le fait que si cette procédure ,pour une raison
quelconque, est interrompue en son milieu, il faudra absolument démarrer
manuellement la procédure "Retabl" ou mettre "Application.EnableEvents" à
True.(Application.EnableEvents = True).
Private Sub Worksheet_Activate()
On Error GoTo gesterr
Dim ws As Worksheet, Fin As Integer
Detabl
Fin = Range("B65536").End(3).Row
For Each ws In ThisWorkbook.Worksheets
If IsError(Application.Match(ws.Name, Range("B1:B" & Fin), 0)) Then
Fin = Range("B65536").End(3).Row
Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone
Range("B" & Fin + 1).Font.Bold = True
Range("B" & Fin + 1) = ws.Name
Rows(Fin).AutoFit
End If
Next
Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone
ActiveSheet.ScrollArea = "A1:D" & Fin + 2
Range("B" & [B10:B34].Find("", LookIn:=xlValues).Row).Select
gesterr:
Retabl
End Sub
"Bonjour LionelB La proc. est sans erreur cette fois. Je retiens ton attention sur le fait que si cette procédure ,pour une raison quelconque, est interrompue en son milieu, il faudra absolument démarrer manuellement la procédure "Retabl" ou mettre "Application.EnableEvents" à True.(Application.EnableEvents = True).
Private Sub Worksheet_Activate() On Error GoTo gesterr Dim ws As Worksheet, Fin As Integer Detabl Fin = Range("B65536").End(3).Row For Each ws In ThisWorkbook.Worksheets If IsError(Application.Match(ws.Name, Range("B1:B" & Fin), 0)) Then Fin = Range("B65536").End(3).Row Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone Range("B" & Fin + 1).Font.Bold = True Range("B" & Fin + 1) = ws.Name Rows(Fin).AutoFit End If Next Range("B" & Fin + 1 & ":C" & Fin + 1).Interior.ColorIndex = xlNone ActiveSheet.ScrollArea = "A1:D" & Fin + 2 Range("B" & [B10:B34].Find("", LookIn:=xlValues).Row).Select gesterr: Retabl End Sub
