Classeur 1 extraire feuille BD vers nouveau classeur 2 [Résolu]

[timtof2011]

bonsoir,

voilà nouveau problème...
Je joins à ce message un fichier test.xls car je pense que ce sera plus facile pour vous m'aider...

Ce fichier test.xls utilise une feuille BD qui est la base de donnée...j'aimerai l'extraire et la placer dans un nouveau classeur BD.xls et ainsi avoir mon fichier BD.xls séparé du fichier programme test.xls

merci encore une fois pour votre aide.
Tim

[mercatog]

Code :

1
2
3
4
5
6
7
Sub TEST()
 
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("BD").Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\FichierBD.xls"
ActiveWorkbook.Close
End Sub

[timtof2011]

Merci bcp mercatog...

Mais je pense que je n'étais pas assez précis dans ma demande.

Ce que j'aurai aimé c'est à partir du fichier joint écrire et lire ce Fichier BD.xls à partir du test.xls...

Mon but est de travailler sur un fichierBD séparé de test mais cela en permanence.

Encore merci à toi.
Tim

Bon voilà ce que j'arrive à faire...apres pas mal d'essai

j'ai placé ceci sur le UserForm de mon fichier test.xls de départ

Code :

1
2
3
4
Option Explicit
 
Const ChDir = "C:\KeiserFabrice\Exemples\test"
Const NomFichier = "BDC.xlsm"

et j'ai placé ceci

Code :

1
2
3
4
5
6
Private Sub UserForm_Initialize()
     '   Ouverture du fichier BDC
     Workbooks.Open Filename:=("C:\Excel\test" & "\" &   NomFichier)
IniListview
 
End Sub

c'est ok pour moi...résultat ça m'ouvre bien mon classeur BDC.xls au lancement de mon programme test.xls

Mais par rapport au code de test.xls je ne vois pas comment faire pour écrire ou voir directement dans le BDC.xls

J'ai besoin d'aide... Merci

[mercatog]

Je ne vois pas le code de la sub IniListview

[timtof2011]

Merci de prendre le temp de suivre mon problème mercatog...

je te joins les deux fichiers:
1. test.xls ' mon programme (enfin que j'ai trouvé)
2. BDC.xls ' le fichier que j'aimerai écrire et lire à partir de test.xls

je redéfini ce que j'aimerai arriver à faire...

donc, lorsque je lance test.xls et que le programme s'ouvre pour le moment il prend la liste dans sa feuille "BD" moi j'aimerai qu'il lise et écrit à partir de mon fichier BDC.xls dans la "feuil1"

voilà d'avance merci pour ton aide.
Tim

[mercatog]

1. Déclarations à ajouter dans ton Module standard

Code :

1
2
3
Public Wbk As Workbook
Public Const Rep = "C:\Users\user\Desktop" '"C:\Excel\test"    'Déplacée ici
Public Const Fichier = "BDC.xls"                                          'Déplacée ici

2 Dans module ThisWorkbook

Code :

1
2
3
4
5
6
7
8
9
10
Private Sub Workbook_Open()
 
Set Wbk = Workbooks.Open(Filename:=Rep & "\" & Fichier)
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 
Wbk.Close True
Set Wbk = Nothing
End Sub

3. Et partout où tu as

Code :

Sheets(X)...

Tu remplace par

Code :

Wbk.Worksheets(X)...

dans le cas où la feuille se rapporte à ton fichier BDC.

Allez, au boulot

[timtof2011]

mercatog, je recois une erreur 91 (variable objet ou variable de bloc with non définie. et ça dans UserForm1.Show

je ne vois pas ou est le problème...

Code :

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
Private Sub UserForm_Initialize()
IniListview
 
End Sub
 
Sub IniListview()
Dim i As Long
Wbk.Worksheets("BDC").AutoFilterMode = False
With ListView1
    .ListItems.Clear
    With .ColumnHeaders
       .Clear
       .Add , , "Nom", 140
       .Add , , "Prénom", 140
       .Add , , "Adresse", 140
 
    End With
 .View = lvwReport
 .FullRowSelect = True
 .Gridlines = True
        For i = 2 To Wbk.Worksheets("BDC").Range("A65536").End(xlUp).Row
           .ListItems.Add , , Wbk.Worksheets("BDC").Cells(i, 1)
           .ListItems(.ListItems.Count).ListSubItems.Add , , Wbk.Worksheets("BDC").Cells(i, 2)
           .ListItems(.ListItems.Count).ListSubItems.Add , , Wbk.Worksheets("BDC").Cells(i, 3)
           .ListItems(.ListItems.Count).ListSubItems.Add , , i
        Next
    ListView1.ListItems(1).Selected = False
    Set ListView1.SelectedItem = Nothing
End With
 
End Sub
 
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
ListView1.Sorted = False
ListView1.SortKey = ColumnHeader.Index - 1
    If ListView1.SortOrder = lvwAscending Then
        ListView1.SortOrder = lvwDescending
    Else
        ListView1.SortOrder = lvwAscending
    End If
ListView1.Sorted = True
 
End Sub
 
Private Sub QuitterRecherche_Click()
Wbk.Worksheets("BDC").AutoFilterMode = False
Unload Me
 
End Sub
 
Private Sub Selectionner_Click()
Flag = False
UserForm2.Show
If Flag = False Then Exit Sub
ListView1.ListItems.Clear
With Wbk.Worksheets("BDC")
    .AutoFilterMode = False
    .Range("A1").AutoFilter Field:=Col, Criteria1:=Sel
    For Each Cel In .Range("A2:A" & .Range("A65536").End(xlUp).Row).SpecialCells(xlVisible)
        With ListView1
            .ListItems.Add , , Cel
            .ListItems(.ListItems.Count).ListSubItems.Add , , Cel.Offset(0, 1)
            .ListItems(.ListItems.Count).ListSubItems.Add , , Cel.Offset(0, 2)
            .ListItems(.ListItems.Count).ListSubItems.Add , , Cel.Offset(0, 3)
            .ListItems(.ListItems.Count).ListSubItems.Add , , Cel.Row
        End With
    Next
End With
 
End Sub
 
Private Sub Initialiser_Click()
    IniListview
End Sub
 
Private Sub Modifier_Click()
Dim Ligne As ListItem
On Error Resume Next
Set Ligne = ListView1.SelectedItem
On Error GoTo 0
If Ligne Is Nothing Then
    MsgBox "Aucune ligne n'est sélectionnée."
    Exit Sub
End If
UserForm4.Show
If FlagMdP = True Then
    With UserForm3
        .TextBox1 = ListView1.ListItems(ListView1.SelectedItem.Index).Text
            For i = 1 To ListView1.ColumnHeaders.Count - 2
                .Controls("TextBox" & i + 1) = ListView1.ListItems(ListView1.SelectedItem.Index).ListSubItems(i).Text
            Next
        .LblLigne = ListView1.ListItems(ListView1.SelectedItem.Index).ListSubItems(9).Text
        .Show
    End With
End If
 
End Sub

[mercatog]

Tu dois d'abord enregistrer, fermer et ré ouvrir ton fichier pour que le Workbook.Open soit exécuté. Dès lors tu auras dans Wbk le classeur BDC que tu viens d'ouvrir à l'ouverture du classeur Test.xls

[timtof2011]

ok mais maintenant je n'ai plus la même erreur c'est devenu '9' l'indice n'appartient pas à la sélection...

désolé de prendre ton temp... mais ça progresse...je le sens

[bbil]

Sur qu'elle ligne l'erreur ?? voir si tu n'as pas une erreur sur le nom d'une feuille par exemple...

[timtof2011]

merci bbil de participer...

l'erreur est renseignée dans le module

Code :

1
2
3
Sub AfficheUserForm1_QuandClic()
     UserForm1.Show 'cette ligne est en jaune
End Sub

j'ai une petite question qui me turlupine...
lorsque je renseigne Wbk.Worksheets("BDC") dans mon code...est ce que je ne dois pas renseigner la feuil1 ?

[mercatog]

Adapte les noms des feuilles des fichiers!

[bbil]

Envoyé par timtof2011

merci bbil de participer...

l'erreur est renseignée dans le module

Code :

ben s'il n'y as qu'une procédure d'une ligne de concerné pourquoi mettre tout ce code ?

ton UserForm1 existe bien dans ton classeur ?

il est placé ou ton code AfficheUserForm1...

[timtof2011]

@ bbil : oui l' userform1 existe tu peux vérifier le code ci-dessus plus haut le commentaire #9 j'y ai placé le code entier du UserFrom1

@ mercatog : sauf erreur j'ai vérifié en long et en large y compris les noms des feuilles j'ai testé sur le fichier BDC.xls en mettant comme nom de la feuille "feuil1" et aussi en la nomment "BDC" rien n'y fait.

[mercatog]

C'est pas une question de tâtonner.
Regarde tes 2 fichiers et comment sont nommées les feuilles et adapte les codes en conséquences. c'est pas difficile à ce stade.

[timtof2011]

merci mercatog...lorsque tu montres un peu les griffes...ça ouvre les yeux...

merci à toi.

je cloture ce post...en vous remerciant tous...

j'y retourne.

Tim