Extraire des données d'un classeur sans l'ouvrir

**sirine_** · 10/10/2014, 02h23

Bonjour à tous,

Je suis en train d'importer et d'utiliser des données sur un classeur qui se trouve sur le méme répertoire que le fichier en cours.
Voila pour expliquer plus, en effet, j'ai un fichier1.xls qui contient mon macro alors je l'ouvre et j"extraire son chemin (path) pour ouvrir l'autre fichier2.xls dès maintenant tout va bien. J'ai réussi d'ouvrir le fichier2 à partir du nom et du path du fichier1.

La deuxième étape consiste à ouvrir une feuille de fichier2.xls pour les copiées et les interrogées avec les données sur fichier1.xls

Mon problème est là en fait lorsque j'ouvre fichier2.xls il devient comme s'il est le dominant (càd thisworkbook) mais moi dans mon programme je mets

le classeur du fichier1.xls --> thisworkbook
et le classeur du fichier2.xls --> wb1=workbook.open (path du fichier2.xls)

comment je peux avancer dans mon travail, je suis coincé à cette étape.

Merci d'avance,

**Theze** · 10/10/2014, 08h14

Bonjour,

Il n'y a aucune raison qu'un classeur prenne l'ascendant sur un autre si tu utilise des variables objet adaptées :

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
 
Sub Test()
 
    Dim Cls_1 As Workbook
    Dim Cls_2 As Workbook
    Dim Fe_1 As Worksheet
    Dim Fe_2 As Worksheet
 
    Set Cls_1 = ThisWorkbook
    Set Fe_1 = Cls_1.Worksheets("Feuil1")
 
    Set Cls_2 = Workbooks.Open(Cls_1.Path & "\" & "fichier2.xls")
    Set Fe_2 = Cls_2.Worksheets("Feuil1")
 
    Fe_1.Range("A1").Value = Fe_2.Range("A1").Value
 
End Sub

Hervé.

**sirine_** · 10/10/2014, 15h28

salut à tous,
salut Hervé,
en fait j'ai essayé votre code mais le problème persiste et plus que ça meme les opération sur le fichier1 ont aussi réalisé sur fichier2 (puisque à chaque macro on va effectuer un "open " pour le fichier et si je fais un autre macro et le fichier est ouvert alors les opérations de fichiers1 vont etre dans le fichier2)

est ce que vous avez d'autres propositions??

merci

**Theze** · 10/10/2014, 16h28

poste ton code entier pour voir !

Hervé.

**sirine_** · 10/10/2014, 17h54

Salut,

voila mon code

merci,

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
Sub Macro1()
 Dim DerLg As Integer
 Dim chemin As String, pos&
Sub Macro1()
 Dim DerLg As Integer
 Dim chemin As String, pos&
 Dim ws As Workbook
 Dim wb As Workbook
 Dim res() As String
 Dim chemin1() As String
 Dim chemin2() As String
 Dim path As String
 Dim nom1 As String
 Dim nom2 As String
 Dim nom3 As String
 Dim wb1 As Workbook, wb2 As Workbook
 Dim str As String
 Dim s As String, s1 As Integer, s2 As Integer
Dim k As Integer
 
 '''''''''''''''''Nom du fichier'''''''
 Set wb1 = ThisWorkbook
         chemin = wb1.Name
         pos = InStr(chemin, ".xlsm")
         nom = Left(chemin, pos - 1)
         res() = Split(nom, "_")
           Range("F4") = res(2)
 
      str = res(4)
       s = Mid(str, 1, 2) & "\" & Mid(str, 3, 2) & "\" & Mid(str, 5, 2)
      Range("F7") = s
 
 
'''''''''''ouvrir le fichier referentiel''''''''''''''''''''''''''''
 
 
path = ActiveWorkbook.path
 
If Right(path, 1) <> "\" Then path = path & "\"
 
nom1 = ActiveWorkbook.Name
 
nom3 = Mid(nom1, 9) 'Pour supprimer les 3 premiers caracteres
 
 Set wb2 = Application.Workbooks.Open(path & "referentiel" & nom3)
' wb2.Close
 ''''''''''''''''''''''''''''''''''''
 
With wb2
 wb2.Worksheets("cablage").Activate
 
  DerLg = wb2.Worksheets("cablage").Cells(Worksheets("cablage").Rows.Count, 1).End(xlUp).Row
 
i = DerLg
j = i - 1
k = 11
 
Do While (wb2.Worksheets("cablage").Cells(i, 1).Interior.ColorIndex <> wb2.Worksheets("cablage").Cells(j, 1).Interior.ColorIndex)
 
With wb1
 
  For s1 = 2 To j
  For s2 = DerLg To j
 
         wb1.Worksheets("cablage").Activate
 
         If (wb2.Worksheets("cablage").Cells(s2, 1).Value = wb2.Worksheets("cablage").Cells(s1, 1).Value) Then
        If (wb2.Worksheets("cablage").Cells(s2, 2).Value <> wb2.Worksheets("cablage").Cells(s1, 2).Value) Then
        If (wb2.Worksheets("cablage").Cells(s2, 13).Value = "break-out SMF" Or wb2.Worksheets("cablage").Cells(s2, 13).Value = "break-out MMF") Then
 
 
         wb1.Worksheets("Liste Produits Stockés").Activate
         wb1.Worksheets("Liste Produits Stockés").Cells(7, 1).Copy wb1.Worksheets("bordereau").Range(A11)
 
         ElseIf (wb2.Worksheets("cablage").Cells(s2, 13).Value = "jarretière SMF" Or wb2.Worksheets("cablage").Cells(s2, 13).Value = "jarretière MMF") Then
 
         wb1.Worksheets("Liste Produits Stockés").Activate
         wb1.Worksheets("Liste Produits Stockés").Cells(8, 1).Copy wb1.Worksheets("bordereau").Cells(k, 1)
 
 
 
         End If
 
 
         End If
         Else
 
 
          wb1.Worksheets("Liste Produits Stockés").Activate
          wb1.Worksheets("Liste Produits Stockés").Cells(7, 1).Copy wb1.Worksheets("bordereau").Cells(k, 1)
          wb1.Worksheets("Liste Produits Stockés").Cells(8, 1).Copy wb1.Worksheets("bordereau").Cells(k, 1)
 
 
 
End If
 
Next s2
Next s1
                i = i - 1
                j = j - 1
                k = k + 1
 
 
End With
 
Loop
 End With
End Sub

**Theze** · 11/10/2014, 14h07

Bonjour,

Teste le code ci-dessous en ayant auparavant lu les commentaires et reviens si ça ne fonctionne pas comme prévu :

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
 
Sub Macro1()
 
Dim Cls_1 As Workbook
Dim Cls_2 As Workbook
Dim Fe_Produits As Worksheet
Dim Fe_Bordereau As Worksheet
Dim Fe_cablage As Worksheet
 
Dim Chemin As String
Dim Nom As String
Dim Nom2 As String
Dim Compteur_1 As Integer
Dim Compteur_2 As Integer
Dim I As Integer
Dim J As Integer
Dim K As Integer
Dim DerLg As Integer
 
 '''''''''''''''''Nom du fichier'''''''
    Set Cls_1 = ThisWorkbook
 
    Nom = Cls_1.Name
 
    'ce genre de construction est très spécifique à un type de nommage de classeur et ça risque fort de générer des erreurs !
    'à moins que ce soit pour le test de découpage du nom ? Car plus utilisé après !
    Nom = Left(Cls_1.Name, InStr(Cls_1.Name, ".xlsm") - 1)
 
    Range("F4") = Split(Nom, "_")(2)
 
    Nom2 = Split(Nom, "_")(4)
 
    Range("F7") = Mid(Nom2, 1, 2) & "\" & Mid(Nom2, 3, 2) & "\" & Mid(Nom2, 5, 2)
 
'''''''''''ouvrir le fichier referentiel''''''''''''''''''''''''''''
 
 
    Chemin = Cls_1.path
 
    If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
 
    'suppression des 3 premières lettres
    Nom = Right(Cls_1.Name, Len(Cls_1.Name) - 3)
 
    'variable objet "Workbook"
    Set Cls_2 = Application.Workbooks.Open(path & "referentiel" & Nom)
 
    'variable objet "Worksheet", une fois ceci fait, il n'est plus nécessaire de faire référence au classeur
    'car le compilateur sait exactement à quelle feuille de quel classeur il s'agit
    Set Fe_Produits = Cls_1.Worksheets("Liste Produits Stockés")
    Set Fe_Bordereau = Cls_1.Worksheets("bordereau")
    Set Fe_cablage = Cls_2.Worksheets("cablage")
 
    'en utilisant "With - End With", il n'est plus nécessaire de préfixer les objets avec l'objet parent, le compilateur sait
    'que s'il rencontre un objet précédé d'un point, il appartient à son parent, comme ceci par exemple --> .Cells(.Rows.Count, 1).End(xlUp).Row
    With Fe_cablage
 
        DerLg = .Cells(.Rows.Count, 1).End(xlUp).Row
 
        I = DerLg
        J = I - 1
        K = 11
 
        Do While .Cells(I, 1).Interior.ColorIndex <> .Cells(J, 1).Interior.ColorIndex
 
            For Compteur_1 = 2 To J
 
                For Compteur_2 = DerLg To J
 
                    If .Cells(Compteur_2, 1).Value = .Cells(Compteur_1, 1).Value Then
 
                        If .Cells(Compteur_2, 2).Value <> .Cells(Compteur_1, 2).Value Then
 
                            If .Cells(Compteur_2, 13).Value = "break-out SMF" Or .Cells(Compteur_2, 13).Value = "break-out MMF" Then
 
                                Fe_Produits.Cells(7, 1).Copy Fe_Bordereau.Range(A11)
 
                            ElseIf .Cells(Compteur_2, 13).Value = "jarretière SMF" Or .Cells(Compteur_2, 13).Value = "jarretière MMF" Then
 
                                Fe_Produits.Cells(8, 1).Copy Fe_Bordereau.Cells(K, 1)
 
                            End If
 
                        End If
 
                    Else
 
                        Fe_Produits.Cells(7, 1).Copy Fe_Bordereau.Cells(K, 1)
                        Fe_Produits.Cells(8, 1).Copy Fe_Bordereau.Cells(K, 1)
 
                    End If
 
                Next Compteur_2
 
            Next Compteur_1
 
            I = I - 1
            J = J - 1
            K = K + 1
 
        Loop
 
    End With
 
End Sub

Hervé.

Extraire des données d'un classeur sans l'ouvrir [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager