Manipulation de classeur fermé

Question

Bonjour, 

Mon problème est le suivant.

Dans un classeur se trouve un planning qui se présente de la manière suivante :

..........Janv Février Mars Avril....

Poste1..R........................P
Poste2..........P................P
Poste3....................P.......

Sachant qu'il y a environ 700 postes.

Ce que je voudrais faire, c'est qu'en ayant choisi le mois à planifier au préalable, ma macro entre dans une variable tableau (Appelons la Tab_Plan) tout les postes ayant un P dans le mois choisi. (Par exemple, si le mois choisi est Avril, ma variable tableau devrait avoir 2 lignes, Poste1 et Poste2). 
Je précise que je préfèrerais que le classeur contenant le planning reste fermé.

Une fois Tab_Plan complété, je voudrais que pour chaque poste contenue dans le tableau, ma macro aille extraire les spécifications associées qui se situent dans un classeur, sachant qu'il y a un classeur par poste et que les données voulues se trouvent toutes au même endroit dans chaque classeur spécification.

Evidemment, je pense que vu le nombre de poste planifiés à chaque mois, il faudra extraire ces données sans ouvrir les classeurs spec.

Est-ce réalisable ? 

Merci d'avance

Configuration: Windows 8 / Internet Explorer 10.0

pijaku · Answer

Bonjour,

Oui c'est faisable.
Voyez déjà cette discussion, lisez bien également le commentaire de michel_m donné dans cette discussion.

thechoux · Answer

D'accord, donc, si j'ai bien compris, il faudrait que le début de ma macro soit comme ça :

Option Explicit

Dim Donnees(), valeurs()

Sub Import()
Dim FeuilleAimporter As String, Classeur As String, Chemin As String, numChamp As Integer

Classeur = "Préventif_CFE_Planning 2014.xlsm"
FeuilleAimporter = "Suivi"
Chemin = "\frsf-sanview\profiles$	richoux\Bureau\Dossier théo\Dossier graissage" & Classeur
Erase Donnees
Erase valeurs
ImporterLaTable FeuilleAimporter, Chemin, numChamp
End Sub

Sub ImporterLaTable(NomFeuilSource As String, strChemin As String, Colonne As Integer)
Dim Cn As Object
Dim rst As Object

Set Cn = CreateObject("ADODB.connection")
Set rst = CreateObject("ADODB;Recordset")
With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
 End With

Seulement, je capte rien à ces histoires de ADODB, depuis les 2 mois ou j'ai commencé à me plonger dans VBA, j'ai jamais vu ça encore. Qu'est ce que c'est ? Un protocole d'échange entre les fichiers ?

Quand j'exécute la macro, ça me met le message d'erreur suivant : Type défini par l'utilisateur non défini

michel_m · Answer

Bonjour,

Es tu sûr ou obligé d'avoir une variable de tableau puisqu 'il n'y en a pas besoin quand on manipule un fichier fermé ( emploi de SQL) ?

Peut on avoir que des P ou plusieurs lettres style R, G,X....

Le mieux serait que tu joignes ton classeur source avec une cinquantaine  de postes

pour joindre une piècemettre le classeur sans données confidentielles en pièce jointe surhttp://cjoint.com/ puis copier l'adresse du lien et la coller dans le message de réponse

thechoux · Answer

Et bien il me semblait que ça serait plus rapide au niveau du temps d'exécution si j'utilisais une variable tableau. Et pour SQL, je débute en VBA alors SQL...il me semble que c'est un système de gestion de base de données mais mes connaissances s'arrêtent là, j'en suis navré.

Voici le lien du classeur ou je veux concentrer mes données : https://www.cjoint.com/?0EhlUP9llXg
Le lien du classeur ou se trouve le planning : https://www.cjoint.com/?0Ehl1VExSjK 
Le lien de l'archive avec les fichiers spec : https://www.cjoint.com/?0Ehl4nDNcXe

michel_m · Answer

Bonjour,

Je viens de passer pas mal de temps à essayer de comprendre ce que tu voulais faire et ma foi, je dois être borné...

par ex:
je voudrais que pour chaque poste contenue dans le tableau, ma macro aille extraire les spécifications associées qui se situent dans un classeur, 
Lesquelles et où ?

pour la création de tes fiches "spec" pourquoi ne pas créer un modèle et l'appeler: cela évitera ton usine à gaz de macro et tu auras juste à donner le nom de ta fiche ?
je suppose que les sous-dossiers "spec" correspondent à la colonne "unité" du planning: je pose la question car rien ne correspond dans ton envoi... par ex:6C ???
A mon avis, tu as oublié dans le chemin de la fiche le nom du sous-dossier (6C, 6R)


dans ton fichier test, je n'ai rien compris ; aucun commentaire dans tes macros:   dossier source: c'est le quel ? 
Tu crées un userform, OK, mais à quoi sert la variable "verif" et pourquoi utiliser des inputbox assez "bordeliques" puisque le mois est donné par l'userform (un combobox avec le nom des mois aurait été plus simple que 12 optionbutton mais...
Je me demande qu'est ce qu'il faut importer dans ta fiche "spec": la date, mais la quelle: celle du déclenchement de la macro ?

si tu veux travailler avec le planning fermé il faudra ajouter une ligne sous la ligne 8 que tu pourras masquer avec le nom des mois sans accent puisqu'il faut concordance des orthographes (le mode sans accent est le bon)

quant à tes fichiers "spec", il parait difficile de ne pas les ouvrir: il y a peut-^tre une astuce mais pas  forcément évidente
A ce propos, tu as renommé sous format XLs et MSoffice m'envoie un message à chaque demande d'ouverture...

etc, etc...


En général toutes tes macros sont à reprendre car "usine à gaz"

bref, ça semble la planche à savon...

thechoux · Answer

Désolé pour le fouilli, j'aurais du préciser :

-Dans le classeur test, le module dont je me sert est le premier, le module programme. Le module "banque", c'est juste une banque de macro que j'ai trouvé ou déjà faite pour m'aider à faire les suivantes.

-Dans le module programme, je n'ai pas encore lié les macros, je les créée juste par étape.

-Les spécifications de chaque poste planifié sont à extraire des fichiers qui sont dans le dossier spec. 

-Oui effectivement les fiches spécifications sont classées par unité 6E, 6C, VF, VE, il doit y avoir une vingtaine de sous dossier dans le dossier spec.

-Dans les fiches spec je dois extraire les données dans le tableau qui sont dans la 4 feuilles.
-L'option verif, c'est encore autre chose ; tu dois avoir remarqué que dans le planning, dans la colonne de Janvier il y a des R. Cela signifie que les opérations pour le poste n'ont pas été réalisées à la date planifiée, et qu'elles sont donc en retard.
L'option verif, servira à intégrer (ou non) les retards dans le tableau récapitulatif du classeur test.

En fait mes macros du classeur test et du module programme fonctionnent. Ce que je voudrais savoir c'est si c'est possible de faire une macro qui dit par exemple :

Si le mois est 11 alors
   On rentre dans var_tableau(1,i) tout les P de Novembre
   On rentre dans var_tableau(2,i) tout les nom_de_poste qui sont sur la même ligne que les P rentrés
Si verif = Vrai
   On rentre à la suite de var_tableau tout les nom_de_poste qui sont en retard (R dans la colonne Janvier)

Pour chaque fichier du dossier spec,
   Pour chaque ligne de var_tableau
      Si nom_fichier = nom_de_poste Alors
         Copie des données du nom_fichier dans test

Voilà en gros ce que je voudrais faire

En tout cas désolé pour le bordel, j'ai oublié de préciser qu'il y avait que le module programme du fichier test qui était vraiment utile.

Merci pour le temps consacré.

thechoux · Answer

Bonjour,

Voilà j'ai réussi à bidouiller un truc qui marche, mais c'est quand même un peu long à s'exécuter, y'aurait il un moyen pour le rendre moins lourd ?

Function ExisteFichier(fcher As String) As Boolean
ExisteFichier = (Dir(fcher & ".xlsm") <> "")
End Function


Sub Générale()

'Macro qui lance l'userform pour le choix du mois

Demandemois.Show
Dim fichiersource As String
retard = Demandemois.choix 'on enregistre le choix de la prise en compte des retards
moisdemandé = Demandemois.verif 'on enregistre le mois de plannif choisi
fichiersource = Demandemois.dossier 'On enregistre le planning choisi
Unload Demandemois

'Macro qui extrait le planning

    Dim i As Integer
    Dim derlig As Long
    Dim Fichier As String
    Dim fichier1 As String
    Dim a As Integer
    Dim base As String
    Dim nom As String
    Dim ligne As Integer
    Dim colonne As Integer
    nom = ActiveWorkbook.Name
    

 
   
   
    fichier1 = StrReverse(fichiersource)
    a = InStr(fichier1, "\")
    Fichier = Right(fichiersource, a - 1) & ".xlsm"
    
     'Vérification existance fichier
     
   While ExisteFichier(fichiersource) = False And i < 5
        i = i + 1
        fichiersource = InputBox("Veuillez renseigner un nom de fichier valide, essai " & i & "/5", "Fichier introuvable", fichiersource)
   Wend
   
   'Ouverture du planning
    Workbooks.Open(fichiersource & ".xlsm").Activate
    Sheets("Suivi").Activate
    
    'Génération d'une variable tableau pour entrer le planning
    Dim tabplan()
    derlig = Range("B9").End(xlDown).Row 'on cherche la taille du tableau
    ReDim tablodate(derlig - 2, 14)

'On entre le planning dans la variable tableau
  
  
 For ligne = 9 To derlig
       For colonne = 26 To 40
            tablodate(ligne - 8, colonne - 26) = Workbooks(Fichier).Sheets("Suivi").Cells(ligne, colonne).Value
       Next
 Next

'On génère la variable tableau qui va chercher les postes plannifiés pour le mois demandé.

Dim tablopostes()

'On cherche maintenant la dimension du tableau
Dim nPlanifié As Integer
nPlanifié = 0
For ligne = 9 To derlig
    If Cells(ligne, 2) Like "GRA*" Then 'Si l'opération plannifié concerne le graissage
        If Cells(ligne, moisdemandé + 25) Like "*P" Then
            nPlanifié = nPlanifié + 1
        End If
    End If
Next

Dim nRetard As Integer
nRetard = 0

If retard = True Then 'prise en compte des retards
    For ligne = 9 To derlig
        If Cells(ligne, 2) Like "GRA*" Then 'Si l'opération plannifié concerne le graissage
            If Cells(ligne, 26) Like "*R*" Then
                nRetard = nRetard + 1
            End If
        End If
    Next
End If

Dim Nbligne As Integer
Nbligne = nPlanifié + nRetard 'On a trouvé notre nombre de ligne
ReDim tablopostes(Nbligne, 2) 'On redimentionne donc le tableau

'On rempli maintenant le tableau avec les numéros de poste à prendre en compte
Dim position_ As Long
Dim j As Integer
Dim Tableau() As String
j = 0

For ligne = 9 To derlig
    If Cells(ligne, 2) Like "GRA*" Then 'Si l'opération plannifié concerne le graissage
        If Cells(ligne, moisdemandé + 25) Like "*P" Then
            j = j + 1
            position_ = InStr(Cells(ligne, 4), "_") 'On cherche la position du caractere "_" dans la désignation du poste
    
                If position_ = 0 Then
                    MsgBox ("Numéro de poste invalide à la ligne " & ligne & " merci de corriger") 'S'il n'y a pas de "_" dans la cellule alors on affiche un message d'avertissement
                    tablopostes(j, 1) = Cells(ligne, 4).Value 'On rentre quand même la valeur brute dans le tableau, sachant qu'elle risque de ne pas être prise en compte lors de la rcherche des specs
                Else
                    tablopostes(j, 1) = Mid(Cells(ligne, 4), position_ + 1, 10) 'On rentre le numéro de poste dans le tableau
                End If
    
             'on va maintenant rentrer dans la deuxième colonne de tablopostes l'action à effectuer
            'découpe la chaine en fonction des espaces " "
            'le résultat de la fonction Split est stocké dans un tableau
            Tableau = Split(Cells(ligne, 2), "-")
            tablopostes(j, 2) = Tableau(1)
    
        End If
    End If
Next
  

If retard = True Then 'prise en compte des retards
    For ligne = 9 To derlig
        If Cells(ligne, 2) Like "GRA*" Then 'Si l'opération plannifié concerne le graissage
            If Cells(ligne, 26) Like "*R*" Then
                j = j + 1
                position_ = InStr(Cells(ligne, 4), "_") 'On cherche la position du caractere "_" dans la désignation du poste
    
                If position_ = 0 Then
                    MsgBox ("Numéro de poste invalide à la ligne " & ligne & " merci de corriger") 'S'il n'y a pas de "_" dans la cellule alors on affiche un message d'avertissement
                    tablopostes(j, 1) = Cells(ligne, 4).Value 'On rentre quand même la valeur brute dans le tableau, sachant qu'elle risque de ne pas être prise en compte lors de la rcherche des specs
                Else
                    tablopostes(j, 1) = Mid(Cells(ligne, 4), position_ + 1, 10) 'On rentre le numéro de poste dans le tableau
                End If
    
            Tableau = Split(Cells(ligne, 2), "-")
            tablopostes(j, 2) = Tableau(1)
            End If
        End If
    Next
End If

'on va maintenant demander à l'utilisateur quel est le dossier ou se trouve les fichiers spec
 Dim objShell As Object, objFolder As Object
     Dim Chemin As String, Msg As String
     Dim FlagChoix As Long, NbPoint As Integer

     If SelType = 0 Then
          FlagChoix = &H1
          Msg = "Sélectionner un dossier :"
     Else
          FlagChoix = &H4000
          Msg = "Sélectionner un fichier :"
     End If

     Set objShell = CreateObject("Shell.Application")
     Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix)
    
'Si l 'objet retourné est valide, on teste son contenu (item.title)
     'Si on a sélectionné la racine d'une partition, il se compose du nom de la partition,
     ' suivi de sa lettre et ":" entre parenthèses
     NbPoint = InStr(objFolder.Title, ":")
     If NbPoint = 0 Then
          
'Sinon, il se compose du nom du dossier uniquement, sans le chemin précédent
          'On récupère ce chemin à l'aide des propriété et méthode ParentFolder.ParseName
          Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
     Else
          

Chemin = Mid(objFolder.Title, NbPoint - 1, 2) ' si racine on récupère la lettre du lecteur et les 2 points

     End If
     choixdossierfichier = Chemin
     MsgBox choixdossierfichier
    
    'On va maintenant chercher les specs en fonction des postes plannifiés
    Dim FSO As Scripting.FilesystemObject
    Dim DossierSource As Scripting.Folder
    Dim spec As Scripting.file
    Dim r As Long
    Dim derlign As Long
    Set FSO = New Scripting.FilesystemObject
    Set DossierSource = FSO.GetFolder(Chemin)
    
    r = 0
    
    For i = 1 To UBound(tablopostes, 1)
        For Each spec In DossierSource.Files
            If spec.Name Like tablopostes(i, 1) & ".xlsx" Then
                Dim Source As ADODB.Connection
                Dim Rst As ADODB.Recordset
                Dim ADOCommand As ADODB.Command
                Dim nFichier As String, Cellule As String, Feuille As String
                Dim nLigne As Integer
                
                'plage de cellules à importer
                Cellule = "A12:G30"
                
      
                Feuille = "Plan de maintenance$" 'n'oubliez pas d'ajouter $ au nom de la feuille.
                
                nFichier = choixdossierfichier & "\" & spec.Name 'Chemin complet du classeur fermé
                
                Set Source = New ADODB.Connection
                With Source
                    .Provider = "Microsoft.Jet.OLEDB.4.0"
                    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
                     & nFichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
                    .Open
                End With


                Set ADOCommand = New ADODB.Command
                With ADOCommand
                    .ActiveConnection = Source
                    .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
                End With
                  
                Set Rst = New ADODB.Recordset
                Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
                  
                Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
                Workbooks("test.xlsm").Activate
                derlign = Range("B1").End(xlDown).Row
                
                If derlign > 10000 Then
                    Range("B1").CopyFromRecordset Rst
                   
                    For nLigne = 10 To 1 Step -1
                        If Cells(nLigne, 5).Value <> tablopostes(i, 2) Then
                            Range("A" & nLigne & ":" & "H" & nLigne).Delete
                        End If
                    Next
                     Range("A1") = tablopostes(i, 1)
                Else
                
                    Range("B" & derlign + 1).CopyFromRecordset Rst
                    
                    
                    For nLigne = derlign + 10 To derlign + 1 Step -1
                        If Cells(nLigne, 5).Value <> tablopostes(i, 2) Then
                            Range("A" & nLigne & ":" & "H" & nLigne).Delete
                        End If
                    Next
                    Range("A" & derlign + 1) = tablopostes(i, 1)
                End If
            
                Rst.Close
                Source.Close
                Set Source = Nothing
                Set Rst = Nothing
                Set ADOCommand = Nothing

                
            End If
        Next spec
    Next
    
    Set spec = Nothing
    Set DossierSource = Nothing
    Set FSO = Nothing
    
End Sub

Manipulation de classeur fermé

7 réponses

Votre réponse

Discussions similaires

Newsletters