IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBA Discussion :

Ouverture d'une fenêtre à la place de : Fichier = Dir(ThisWorkbook.Path & "\*.xlsm")


Sujet :

VBA

  1. #1
    re
    re est déconnecté
    Membre du Club
    Profil pro
    Inscrit en
    novembre 2005
    Messages
    116
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : novembre 2005
    Messages : 116
    Points : 43
    Points
    43
    Par défaut Ouverture d'une fenêtre à la place de : Fichier = Dir(ThisWorkbook.Path & "\*.xlsm")
    Bonjour,
    A partir du code ci-dessous comment lui indiquer le fichier à traiter par ouverture d'un fenêtre à la place de la ligne : Fichier = Dir(ThisWorkbook.Path & "\*.xlsm")
    D'autre part je n'ai pas trouvé non plus ou est la ligne de départ... si x=17 il affiche les données en ligne 21
    Vous l'avez compris, Je ne suis pas un expert :-(
    Merci pour votre aide


    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
    50
    51
    Sub extractionValeurCelluleClasseurFerme()
      Dim Source As ADODB.Connection
      Dim Rst As ADODB.Recordset
      Dim ADOCommand As ADODB.Command
      Dim Fichier$, Cellule$, Feuille As Worksheet
      Dim Plage(), Col()
      Plage = Array("q18:q30", "q32:q47", "q50:q63", "q67:q80") 'feuille source
      Col = Array(1, 3)
      For i = 1 To Sheets.Count
        'Sheets(i).Rows("2:65536").Clear
        Range("c2:h200").ClearContents
        Range("A90:h200").ClearContents
      Next
     
       Fichier = Dir(ThisWorkbook.Path & "\*.xlsm")
         Do While Fichier <> ""
          If Fichier <> ThisWorkbook.Name Then
            Set Source = New ADODB.Connection
                  Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & ThisWorkbook.Path & "\" & Fichier & ";Extended Properties=""Excel 12.0;HDR=no;"";"
     
            For Each Feuille In ActiveWorkbook.Worksheets
              For i = 0 To 3
               If i = 0 Then x = 17 'ligne 21
               If i = 1 Then x = 3 'ligne 33
               If i = 2 Then x = 4 ' ligne 50
                If i = 3 Then x = 5 'ligne 67
                Cellule = Plage(i)
                Set ADOCommand = New ADODB.Command
                With ADOCommand
                    .ActiveConnection = Source
                    .CommandText = "SELECT * FROM [" & Feuille.Name & "$" & Cellule & "]"
                End With
                Set Rst = Source.Execute("[" & Feuille.Name & "$" & Cellule & "]")
                With Feuille
     
                       .Cells(65536, Col(1)).End(3)(x).CopyFromRecordset Rst
                        End With
     
              Next i
              Rst.Close
            Next
            Source.Close
            Set Source = Nothing
            Set Rst = Nothing
            Set ADOCommand = Nothing
          End If
          Fichier = Dir
        Loop
     
    End Sub

  2. #2
    Rédacteur

    Homme Profil pro
    Administrateur de base de données
    Inscrit en
    août 2013
    Messages
    794
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Oise (Picardie)

    Informations professionnelles :
    Activité : Administrateur de base de données
    Secteur : Finance

    Informations forums :
    Inscription : août 2013
    Messages : 794
    Points : 3 714
    Points
    3 714
    Par défaut
    Bonjour,
    Je n'ai pas tout compris à votre problème, mais pour information et si ça peut vous aider :

    - pour sélectionner un fichier (puis l'ouvrir après ou faire autre chose) :

    Code VBA : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
     
    Sub SélectionFichier()
    Dim Fichier As String
     
    Fichier = Application.GetOpenFilename("Fichier xlsm, *.xlsm")
    If Fichier <> "" Then MsgBox "Fichier sélectionné : " & Fichier
     
    End Sub

    - Pour importer les données d'un fichier si vous connaissez son nom (normalement celui qui a été sélectionné ci-dessus, la feuille concernée et la plage ou les colonnes) :

    Code VBA : 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
     
    Sub ImporterDonneesSansOuvrir()
    Dim Chemin As String, Fichier As String
     
    Chemin = "C:\Users\ott_l\Downloads\" ' a adapter...
    Fichier = "TDB délai de paiement_30-11-2021.xlsx" ' a adapter...
     
    ' S'il faut importer une plage, ici A1:C54, de la feuille FDC du fichier concerné sur la feuille feuil1 du classeur actif :
    ThisWorkbook.Names.Add "plage", RefersTo:="='" & Chemin & "[" & Fichier & "]FDC'!$A$1:$C$54"
        Sheets("Feuil1").[A1:C54] = "=plage"
        Sheets("Feuil1").[A1:C54].Copy
     
    ' S'il faut importer des colonnes, ici les colonne A à C, de la feuille FDC du fichier concerné sur la feuille feuil1 du classeur actif :
    ThisWorkbook.Names.Add "plage", RefersTo:="='" & Chemin & "[" & Fichier & "]FDC'!$A:$C"
        Sheets("Feuil1").[A:C] = "=plage"
        Sheets("Feuil1").[A:C].Copy
    End Sub
    Cordialement.

  3. #3
    re
    re est déconnecté
    Membre du Club
    Profil pro
    Inscrit en
    novembre 2005
    Messages
    116
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : novembre 2005
    Messages : 116
    Points : 43
    Points
    43
    Par défaut
    Bonjour
    Merci beaucoup pour vos conseils et merci aussi pour vos articles

Discussions similaires

  1. Réponses: 7
    Dernier message: 07/07/2010, 20h27
  2. Erreur sur l'ouverture d'une fenêtre popup
    Par misa dans le forum Général JavaScript
    Réponses: 5
    Dernier message: 25/11/2005, 15h21
  3. Ouverture d'une fenêtre ms-dos malgré l'utilisation de .pyw
    Par Ank dans le forum Général Python
    Réponses: 2
    Dernier message: 21/10/2005, 14h33
  4. Ouverture de la fenêtre des imprimantes avec fichier .bat ??
    Par bbkenny dans le forum Autres Logiciels
    Réponses: 2
    Dernier message: 04/05/2005, 18h13
  5. [HTTPS] ouverture d'une fenêtre
    Par Boosters dans le forum Général JavaScript
    Réponses: 4
    Dernier message: 07/01/2005, 14h08

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo