XL 2010 VBA ouverture d'onglets depuis un autre classeur

[Kire36]

Bonjour à tous

je suis nouveau sur ce forum, et j'ai un blocage au sujet d'une recherche d'un onglet spécifique Excel dans un classeur "Suivi", en "double-cliquant" sur une cellule d'une feuille dans un autre classeur "Navigation" suivant la macro ci dessous,

En mode un seul classeur tout est OK.


Voici ce que je possède à ce jour :

1 classeur avec une feuille (feuil1) dans laquelle est un tableau de 9 colonnes sur 1000 lignes, en colonne B j'ai des n° (ex : KJ0230 en B5 - KJ0235 en B8 - KJ0530 en B130 ... etc) puis dans ce même classeur j’ai d’autres feuilles (onglets) il y a autant d'onglets que de numéros (ex : feuille 2 ( onglet 2 = KJ0230), feuille 3 ( onglet 3 = KJ0235 ....)

à ce jour tout est dans le même classeur, et ma recherche suivant ma macro ci dessous fonctionne à merveille

Fonctionnement : double clic dans cellule B5, ouverture de la feuille KJ0230, aperçu en mode imprimable,


Ce que je cherche, c'est avoir un classeur "Navigation" avec une feuille ou serait le tableau de 9 colonnes sur 1000 lignes et un autre classeur "Suivi" qui aurait toutes les feuilles (onglets) KJ0230;KJ0235;......

Ma question : quelle est la macro à employer pour avoir le même résultat (ma macro) mais avec des classeurs distincts. j'ai cherché mais en vain il y a toujours un bug pour retrouver le fichier "Suivi"

Ci-dessous Ma Macro (1 seul classeur)


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim derlig

derlig = Range("B" & Application.Rows.Count).End(xlUp).Row

If Not Application.Intersect(Target, Range("B3:B" & derlig)) Is Nothing Then

Dim Var As String

Var = Target.Value

Application.ScreenUpdating = False

Sheets(Var).Activate

ActiveWindow.SelectedSheets.PrintPreview

Application.ScreenUpdating = True

Sheets("Navigation").Activate

Range("B1").Activate

End If

End Sub

pourriez vous orienter ma recherche, y a t il une solution SVP ?
Par avance Merci

 

[Robert]

Bonjour Kire, bonjour le forum,

Peu-être comme ça (à adapter) :

Dim OS As Worksheet
Dim CD As Workbook
Dim OD As Worksheet
Dim derlig
Dim Var As String

Application.ScreenUpdating = False
Set CS = ThisWorkbook
Set OS = CS.Worksheets("Navigation")
Set OD = worksbooks("Ici_le_nom_du_classeur-destination.xlsx")
derlig = OS.Range("B" & Application.Rows.Count).End(xlUp).Row
If Not Application.Intersect(Target, OS.Range("B3:B" & derlig)) Is Nothing Then
    CD.Activate
    On Error Resume Next
    Set OS = CD.Worksheets(Target.Value)
    OS.Activate
    If Err <> 0 Then
        Err.Clear
        MsgBox "L'onglet " & Target.Value & ", nexiste pas !"
        Exit Sub
    End If
    On Error GoTo 0
    ActiveWindow.SelectedSheets.PrintPreview
    Application.ScreenUpdating = True
    OS.Activate
    OS.Range("B1").Activate
End If
Application.ScreenUpdating = True
End Sub

 

[Kire36]

Merci bien Robert
j ai mis en oeuvre le fichier VBA que vous m'avez fait parvenir, mais l'ayant retourné dans tous les sens je suis en permanence bloqué sur la ligne "set OD" n'ayant plus de piste de recherche et au bout de mes essais je vous joint les fichiers utiles à mon besoin en espérant qu'il y ai une issue compréhensible.

 

[Robert]

Re,

En effet, il y avait des erreurs dans mon code. Essaie comme ça :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim CS As Workbook
Dim OS As Worksheet
Dim CD As Workbook
Dim OD As Worksheet
Dim derlig

Application.ScreenUpdating = False
Set CS = ThisWorkbook
Set OS = CS.Worksheets("liste de choix")
Set CD = Workbooks("Suivi.xlsx")
derlig = OS.Range("B" & Application.Rows.Count).End(xlUp).Row
If Not Application.Intersect(Target, OS.Range("B2:B" & derlig)) Is Nothing Then
    CD.Activate
    On Error Resume Next
    Set OS = CD.Worksheets(Target.Value)
    OS.Activate
    If Err <> 0 Then
        Err.Clear
        MsgBox "L'onglet " & Target.Value & ", nexiste pas !"
        Exit Sub
    End If
    On Error GoTo 0
    ActiveWindow.SelectedSheets.PrintPreview
    OS.Activate
    OS.Range("B1").Activate
End If
Application.ScreenUpdating = True
End Sub

 

[Kire36]

Un grand Merci à vous Robert, la fonction est remplie, le résultat escompté est bien la et cela fonctionne correctement reste à faire quelques aménagement dans les fichiers et tout sera parfait.
Encore Merci
Kire36