Discussion :

[nunnu27]

Bonjour,

Je viens vers vous car j'ai besoin de votre aide.
En effet, j'ai un code me permettant de demander l'ouverture de certain type de fichier excel (xlsm et xls), cependant je suis obligé d'en selectionner plusieurs pour pouvoir valider l'action alors que moi je ne souhaite en ouvrir qu'un seul...

Je vous joints le code en esperant avoir été assez clair dans mes explications.
Merci d'avance a vous!

cordialement

code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Sub OuvreClasseurs()
Dim strFiles
Dim xlFiles
Dim blnOuvert As Boolean
Dim strMessage As String
Dim wbk As Workbook
Dim i As Integer
Dim j As Integer
' Affiche la boîte de dialogue Ouvrir
strFiles = Application.GetOpenFilename _
(filefilter:="Fichiers Excel (*.xlsm),*.xlsm, (*.xls),*.xls", _
Title:="Sélectionnez les fichiers à ouvrir", _
MultiSelect:=True)
' Teste si des fichiers ont été sélectionnés
If TypeName(strFiles) = "Variant()" Then
ReDim xlFiles(UBound(strFiles))
For i = 1 To UBound(strFiles)
' Contrôle l'extension du fichier
If Right(strFiles(i), 4) = "xlsm" Then
' Teste si le fichier est déjà ouvert
blnOuvert = False
For Each wbk In Workbooks
If wbk.Path & "\" & wbk.Name = strFiles(i) Then
blnOuvert = True
End If
Next wbk
' Stocke le nom de fichier dans un tableau
If Not blnOuvert Then
j = j + 1
xlFiles(j) = strFiles(i)
strMessage = strMessage & strFiles(i) & vbCr
End If
End If
Next i
' Ouvre tous les fichiers Excel après confirmation
If j > 1 Then
strMessage = "Confirmez-vous l'ouverture des fichiers : " _
& vbCr & strMessage
If MsgBox(strMessage, vbYesNo + vbQuestion) = vbYes Then
For i = 1 To j
Workbooks.Open Filename:=xlFiles(i)
Next i
End If
End If
Else
MsgBox "Aucun fichier sélectionné"
End If
 
End Sub

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
27
Sub OuvreClasseurs()
Dim strFiles As Variant
Dim blnOuvert As Boolean
Dim wbk As Workbook
 
' Affiche la boîte de dialogue Ouvrir
strFiles = Application.GetOpenFilename _
           (filefilter:="Fichiers Excel (*.xlsm),*.xlsm,(*.xls),*.xls", _
            Title:="Sélectionnez les fichiers à ouvrir", _
            MultiSelect:=False)
' Teste si des fichiers ont été sélectionnés
If strFiles <> False Then
    For Each wbk In Workbooks
        If wbk.FullName = strFiles Then
            blnOuvert = True
            Exit For
        End If
    Next wbk
    If blnOuvert Then
        MsgBox "Fichier déjà ouvert"
    Else
        Workbooks.Open Filename:=strFiles
    End If
Else
    MsgBox "Aucun fichier sélectionné"
End If
End Sub

[nunnu27]

Bonjour Mercatog,

Tout d'abord, un grand merci pour ta reponse rapide !
De plus, et c'est le plus important ton code fonctionne parfaitement !

Bon, je n'ai pas encore très bien copris les modifications effectuées sur le code mais je vais me pencher dessus...

Dans tout les cas un grand merci encore pour ton temps passé à me débloquer!!!

A très bientot

Cordialement

[nunnu27]

Ah si en fait ...

Selon toi est-il possible de creer une macro "toujours active" qui puisse generer une fenetre (dont la taille serait parametrable car pour un pc tactile donc a utiliser avec des gros doigt!) qui afficherai des mots deja preparer (comme un menu deroulant grossierement...).

Merci d'avance encore une fois pour ton aide et ton temps passé.

Cordialement