Probleme macro "ouverture de fichier"
Résolu
nunnu27
Messages postés
20
Date d'inscription
Statut
Membre
Dernière intervention
-
nunnu27 Messages postés 20 Date d'inscription Statut Membre Dernière intervention -
nunnu27 Messages postés 20 Date d'inscription Statut Membre Dernière intervention -
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:
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
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:
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
A voir également:
- Probleme macro "ouverture de fichier"
- Fichier bin - Guide
- Fichier epub - Guide
- Fichier rar - Guide
- Comment réduire la taille d'un fichier - Guide
- Fichier .dat - Guide
4 réponses
Bonjour,
A priori il suffit de remplacer le test
If j > 1 Then ...
par
If j >= 1 Then ...
A tester
A+
A priori il suffit de remplacer le test
If j > 1 Then ...
par
If j >= 1 Then ...
A tester
A+
Bonjour Pilas et merci de ta reponse ;)
La solution est tombée il y a quelques minutes en fait.
En effet, tu n'étais pas dans le faux :)
voici le code qui fonctionne et merci encore pour ta demarche a mon égard.
cordialement,
code:
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
Ce code fonctionne parfaitement (merci a mercatog de "developpez.com" qui a modifié mon code afin de le rendre fonctionnel).
En esperant que ca puisse aider quelqu'un dans le futur.
Cordialement et bonne fin de journée Pilas ! :)
++
La solution est tombée il y a quelques minutes en fait.
En effet, tu n'étais pas dans le faux :)
voici le code qui fonctionne et merci encore pour ta demarche a mon égard.
cordialement,
code:
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
Ce code fonctionne parfaitement (merci a mercatog de "developpez.com" qui a modifié mon code afin de le rendre fonctionnel).
En esperant que ca puisse aider quelqu'un dans le futur.
Cordialement et bonne fin de journée Pilas ! :)
++