Reproduire partie menu

Version imprimable

18/05/2010, 07h00
2o

Reproduire partie menu

Bonjour,

Pour mon employeur, je mets au point une gestion d’informations collationnées sous Excel 2003, puis importées dans Access.

Pour des raisons d’ergonomie et de sécurité quant à la manipulation des données par les utilisateurs d’Excel, j’ai élaboré sous VBA une série de menus adaptés à la progression des traitements de celles-ci.

Je rencontre le souci suivant, et pour lequel je fais appel à vos connaissances.

Il est impératif de reproduire dans un des menus une partie du menu d’Excel, Worksheet Menu Bar, à savoir une partie du contenu de la commande « Fenêtre ».

Je dois permettre aux opérateurs de saisie d’accéder à d’autres fichiers Excel ouverts sur leur ordinateur, afin qu’ils puissent y sélectionner par un copier coller des données puis, après être retournés sur l’application, les insérer dans une feuille de calcul.

Cette manipulation est possible en utilisant le menu « Fenêtre », puis en faisant en clic sur le nom d’un des fichiers ouverts, commande VBA Windows (nom du fichier). Activate.

J’ai essayé de générer le menu « Fenêtre » dans une nouvelle barre, en axant mes recherches sur la piste d’un « commandbars » avec l’ID correspondant mais en vain.

Cette solution me semble être la plus adéquate pour répondre à la résolution de la situation.

Je vous remercie pour l’attention que vous porterez à ma démarche et toute votre aide.

-B

bonjour,

une solution possible serait d'associer la macro suivante à un bouton de la commandbar personnalisée.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Les_Classeurs_de_Application()
Dim wk()
Dim i As Integer, No_wk As Variant, s As String
 
    For i = 1 To Application.Workbooks.Count
     ReDim Preserve wk(i)
     wk(i) = Workbooks(i).Name
     s = s & i & " - " & Workbooks(i).Name & Chr(10)
    Next
 
    No_wk = InputBox("Entrer le numéro du classeur à activer" & Chr(10) & Chr(10) & s)
    If No_wk = "" Then Exit Sub
    If Not IsNumeric(No_wk) Or No_wk < LBound(wk) + 1 Or No_wk > UBound(wk) Then
     MsgBox " Votre inscription n'est pas correcte, recommencer"
    Else
     Workbooks(wk(No_wk)).Activate
    End If
 
End Sub

Bonsoir,

Je vous remercie donc pour votre suggestion astucieuse et efficace.
J'ai intégré votre code dans le programme.

En voici la version adaptée :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub AtteindreAutresClasseursOuverts()
'Permet à l'utilisateur d'accéder aux classers excel ouverts
'Source Club.Developpez.com
Dim Tableau()
Dim RangElement As Integer, ChoixUtilisateur As Variant, ReferenceClasseur As String
 
    'Recherche de la liste des classeurs ouverts, afin d'en afficher le contenu
        For RangElement = 1 To Application.Workbooks.Count
            ReDim Preserve Tableau(RangElement) 'Espace de stackage du tableau
            Tableau(RangElement) = Workbooks(RangElement).Name
            ReferenceClasseur = ReferenceClasseur & RangElement & " - " & Workbooks(RangElement).Name & Chr(10)
        Next
    'Contenu de la liste des classeurs ouverts affiché _
        Demande choix à l'utilisateur
    ChoixUtilisateur = InputBox("Parmi les documents déjà ouverts" & Chr(10) & "en choisir un dans la liste ci-dessous" & Chr(10) & Chr(10) & ReferenceClasseur & Chr(10) & "N°" & Chr(10), "Accéder à un autre document Excel déjà ouvert")
    'Gestion de la réponse de l'itilisateur
        'Pas de réponse
            If ChoixUtilisateur = "" Then Exit Sub
        'Réponse hors proposition
            If Not IsNumeric(ChoixUtilisateur) Or ChoixUtilisateur < LBound(Tableau) + 1 Or ChoixUtilisateur > UBound(Tableau) Then
                MsgBox "Votre réponse n'est pas dans la liste" & Chr(10) & Chr(10) & "Demande annulée", vbApplicationModal + vbExclamation, ""
            Else
                'Bascul vers le classeur ouvert choisi
                Workbooks(Tableau(ChoixUtilisateur)).Activate
            End If
End Sub

A charge de revenche

Cordialement

-BG