ouvrir une fichier via boîte de dialogue

Vilain

XLDnaute Accro
Bonjour à tous,

Je cherche à ouvrir un fichier via une boite de dialogue. J'utilise pour le moment ce bout de code :
Dim a As Variant, b As Variant, Nom As String, Nom2 As String

Nom = ActiveWorkbook.Name
ChDrive "C:" ' Choix du lecteur
ChDir "C:\" 'Choix du répertoire
a = Application.GetOpenFilename("fichier excel (*.xlsx), *.xlsx", _
, "Sélection de vos fichiers excel", , True)

Cela fonctionne bien mais la boite dialogue qui s'ouvre est toujours celle de mon C: alors que je voudrais que ce soit celle dans lequel mon fichier est enregistré. Je ne parviens pas à faire le changement nécessaire.
Quelqu'un a une idée ?

Merci d'avance
 

Vilain

XLDnaute Accro
Re : ouvrir une fichier via boîte de dialogue

Je reviens à la charge avec le même problème.
Je n'arrive pas à modifier mon code pour que cela marche sur mon fichier.
Je suis aller de forum en forum et la réponse est toujours la même : ThisWorkbook.Path
Le souci c'est que je n'arrive pas du tout à l'appliquer à mon code.
Je te joins le code intégral de ma macro :
Code:
Sub Import_Nmoins2()

Dim cl As Range
Dim str As Variant
Dim ok As Boolean
'
'On teste si il n'y a pas de cellule vide dans la plage
'Si une cellule est vide on informe l'utilisateur et on sort de la procédure
For Each cl In Worksheets("Accueil").Range("B9")
   If cl.Value = "" Then
      MsgBox "L'année de référence n'est pas renseignée", vbExclamation, "Message Erreur"
      cl.Activate
      Exit Sub
   End If
Next cl


 'Suppression de l'affichage des calculs
    Application.ScreenUpdating = False
    
Dim a As Variant, b As Variant, Nom As String, Nom2 As String

Nom = ActiveWorkbook.Name
ChDrive "C:" ' Choix du lecteur
ChDir "C:\" 'Choix du répertoire
a = Application.GetOpenFilename("fichier excel (*.xlsx), *.xlsx", _
, "Sélection de vos fichiers excel", , True)

Select Case TypeName(a)
Case Is = "Boolean"
Exit Sub
Case Else
For b = LBound(a) To UBound(a)
Workbooks.Open a(b)
Next
End Select

Nom2 = ActiveWorkbook.Name
Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
Windows(Nom).Activate
Sheets("JC N-2 par mission").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

 Application.DisplayAlerts = False
    Windows(Nom2).Close
    Application.DisplayAlerts = True
    
    Sheets("Accueil").Activate
     
     'Suppression de l'affichage des calculs
    Application.ScreenUpdating = True

End Sub

Une idée de la ligne à modifier ?
Merci d'avance
 

Lone-wolf

XLDnaute Barbatruc
Re : ouvrir une fichier via boîte de dialogue

Bonjour Vilain

je ne comprends pas ceci : For Each cl In Worksheets("Accueil").Range("B9")
Pour chaque cellules dans la cellule B9 ??? :confused:


Et

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Selectionner la cellule A1 mais de quelle feuille???



A+ :cool:
 
Dernière édition:

Vilain

XLDnaute Accro
Re : ouvrir une fichier via boîte de dialogue

Bonjour à toi,
For Each cl In Worksheets("Accueil").Range("B9") est un code pas très propre je te l'accorde mais qui effectue bien ce qu'on lui demande (à savoir un test sur une seule cellule)

ce bout de code :
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
sert à copier les données dans le fichier qu'on sélectionne via la boite de dialogue.

Pour l'instant tout marche mais mon problème c'est que le chemin dans la boite de dialogue n'est pas celui que je souhaite (je souhaite que ce soit le dossier dans lequel le fichier est sauvegardé).
C'est plus clair ?

Merci par avance
 

Lone-wolf

XLDnaute Barbatruc
Re : ouvrir une fichier via boîte de dialogue

Re Vilain,

voici un bout e code qui m'ouvre le dossier par défaut, à adapter.


Code:
Dim Chemin
    
    Chemin = Application.GetOpenFilename("*.*, *.*")
    ChDrive "D"
    ChDir ("D:\Dossiers Excel\The Best Of VBA\Carnet d'adresses\")
    
    If VarType(Chemin) <> 11 Then
For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) Then
                      Chaine = Chaine & " " & ListBox1.List(i) & ";"
            End If
      Next i
  
    Set olApp = CreateObject("Outlook.Application")
    Set objMail = olApp.CreateItem(olMailItem)
    
    With objMail
    .To = Nouveau.Email.Value
    .cc = ""
    .BCC = Trim(Chaine)
    .Subject = ""
    .Body = ""
    .Attachments.Add Chemin
    .Display
    End With
End if


A+ :cool:
 

Lone-wolf

XLDnaute Barbatruc
Re : ouvrir une fichier via boîte de dialogue

Re Vilain,

une correction pour l'ouverture au dossier

Code:
Dim Chemin As String
Dim BdOpen
   
      Chemin = ThisWorkbook.Path & "\"
       BdOpen = Application.Dialogs(xlDialogOpen).Show(Chemin)

    If VarType(BdOpen) <> False Then
      Exit Sub
      End If


A+ :cool:
 

Lone-wolf

XLDnaute Barbatruc
Re : ouvrir une fichier via boîte de dialogue

Re Vilain,

Cette fois c'est la bonne syntaxe pour ouvrir le dossier par defaut. À adapter bienentendu.


Code:
Private Sub Envois_Click()
Dim i As Byte
Dim olApp, objMail
Dim olmail As MailItem
Dim Chaine As String, OpenFolder
   
    ChDrive "D"
    ChDir ThisWorkbook.Path & "\"
    OpenFolder = Application.GetOpenFilename("(*.*),*.*")
    
    For i = 0 To ListBox1.ListCount - 1
      If ListBox1.Selected(i) Then
            Chaine = Chaine & " " & ListBox1.List(i) & ";"
        End If
      Next i
  
    Set olApp = CreateObject("Outlook.Application")
    Set objMail = olApp.CreateItem(olMailItem)
    
    With objMail
    .To = Nouveau.Email.Value
    .cc = ""
    .BCC = Trim(Chaine)
    .Subject = ""
    .Body = ""
    If OpenFolder <> False Then .Attachments.Add OpenFolder
    .Display
    End With
End Sub
 
Dernière édition:

Si...

XLDnaute Barbatruc
Re : ouvrir une fichier via boîte de dialogue

salut

Bonjour à toi,
vouloir boucler sur une cellule c'est Vilain :p
For Each cl In Worksheets("Accueil").Range("B9") est un code pas très propre je te l'accorde mais qui effectue bien ce qu'on lui demande (à savoir un test sur une seule cellule)

ce bout de code :
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
sert à copier les données dans le fichier qu'on sélectionne via la boite de dialogue. ??

Pour l'instant tout marche pourvu que ça dure ;)

Code modifié (base gardée) avec mon décryptage (mais il n'est peut-être pas bon :confused: alors :cool:)

Code:
Sub Import_Nmoins2()
‘pas besoin d’une boucle pour 1 cas  
  Dim cl As Range
  Set cl = Worksheets("Accueil").Range("B9")
  If cl = "" Then
    MsgBox "L'année de référence n'est pas renseignée", vbExclamation, "Message Erreur"
    cl.Select : Exit Sub
  End If
‘suite 
   Application.ScreenUpdating = False
   Dim a, Nom As String, Nom2 As String
   Nom = ActiveWorkbook.Name
   ChDrive "…" 'Choix du répertoire à ouvrir !
   a = Application.GetOpenFilename("fichier excel (*.xlsx), *.xlsx", , _
        "Sélection de vos fichiers excel", , True)
   If UBound(a) = 0 Then Exit Sub
   Workbooks.Open a(1)
   Nom2 = ActiveWorkbook.Name
   Range("A1").CurrentRegion.Copy
   Windows(Nom).Activate 'activation du classeur appelant
   Sheets("JC N-2 par mission").Select 'onglet dans le classeur appelant
   Range("A1").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False  Application.DisplayAlerts = False
   Windows(Nom2).Close
   Application.DisplayAlerts = True
   Sheets("Accueil").Activate
   MsgBox "mission accomplie"
End Sub

Nota :
- ChDrive "…" permet d'ouvrir le chemin indiqué en remplaçant les points.
- a est le tableau des fichiers sélectionnés dans la boîte de dialogue. Il peut y en avoir plusieurs, mais, ici, le traitement se fait seulement avec le premier.
 

Discussions similaires

Réponses
15
Affichages
782
Réponses
1
Affichages
269
Compte Supprimé 979
C

Statistiques des forums

Discussions
311 720
Messages
2 081 899
Membres
101 834
dernier inscrit
Jeremy06510