Exporter et importer des fichiers

Re : Exporter et importer des fichiers

Bonjour hervé, le fil

Hervé, tu vas reconnaitre dans les codes ci-dessous certains de tes enfants 😀

Option Explicit
Dim Chge As Boolean

Private Sub UserForm_Initialize()
InitArchives
End Sub

Private Sub ComboBox1_Change()
If Me.ComboBox1.ListIndex = 1 Then Me.Txt_No.SetFocus
End Sub

Private Sub Txt_No_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 44 Or KeyAscii = 46 Then
KeyAscii = Asc(Application.International(xlDecimalSeparator))
End If
End Sub

Private Sub Txt_No_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case Is = 8
Chge = True
Case Is = 13, 96 To 105
Case Else
KeyCode = 0
End Select
End Sub

Private Sub Txt_No_KeyUP(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Select Case KeyCode
Case Is = 46
Chge = True
Me.Txt_No = ""
End Select
End Sub

Private Sub Txt_No_Change()
If Not Chge Then
With Me.Txt_No
Select Case Len(.Text)
Case 3, 7, 11
.Text = .Text & " "
End Select
End With
Else
Chge = False
End If
End Sub

Private Sub Cmb_LancerRecherche_Click()
Dim colonne As Byte
Dim ligne As Integer
Dim c As Range
Dim x As Integer
Dim i As Byte
On Error Resume Next
With Me.Lsv_Archives
With .ColumnHeaders
.Clear
.Add , , "N° du Client", 70
.Add , , "N° Ent.", 50, lvwColumnLeft
.Add , , "N° SIREN", 70, lvwColumnCenter
.Add , , "Nom du Client", 200, lvwColumnLeft
End With
.CheckBoxes = True
.FullRowSelect = True
.Gridlines = True
.ListItems.Clear
.View = lvwReport
End With
colonne = IIf(ComboBox1.ListIndex = 0, 3, 1)
If Me.Txt_No = "" Then Me.Lbl_Impossible.Visible = True
If Me.Lbl_Impossible.Visible = True Then
Me.ComboBox1.Visible = False
Me.Lsv_Archives.Visible = False
Me.Lbl_Recherche.Visible = False
Me.Txt_No.Visible = False
Me.Cmb_LancerRecherche.Visible = False
Me.Lbl_NbCltsArchives.Visible = False
Me.Txt_NbCltsArchives.Visible = False
Exit Sub
End If
With ThisWorkbook.Worksheets("Archives")
ligne = .Cells(65536, colonne).End(xlUp).Row
For Each c In .Range(.Cells(2, colonne), .Cells(ligne, colonne))
If c = CDbl(Txt_No) Then
x = x + 1
Me.Lsv_Archives.ListItems.Add , , .Cells(c.Row, 1)
For i = 2 To 4
Me.Lsv_Archives.ListItems(x).ListSubItems.Add , , .Cells(c.Row, i)
Next i
End If
Next c
End With
Me.Lbl_Recherche.Visible = False
Me.ComboBox1.Visible = False
Me.Lbl_NbCltsArchives.Visible = False
Me.Txt_No.Visible = False
Me.Cmb_LancerRecherche.Visible = False
Me.Txt_NbCltsArchives.Visible = False
Me.Lbl_NbCltsTrouves.Visible = True
With Me.Txt_NbCltsTrouves
.Visible = True
Me.Txt_NbCltsTrouves = Lsv_Archives.ListItems.Count - 0
Me.Txt_NbCltsTrouves = Format(Me.Txt_NbCltsTrouves, "### ##0")
End With
End Sub

Private Sub Cmb_RetourArchives_Click()
InitArchives
End Sub

Private Sub Cmb_SelectArchives_Click()
'SelectArchives
End Sub

Private Sub Lsv_Archives_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
With Me.Lsv_Archives
.Sorted = False
.SortKey = ColumnHeader.Index - 1
If Me.Lsv_Archives.SortOrder = lvwAscending Then
Me.Lsv_Archives.SortOrder = lvwDescending
Else
Me.Lsv_Archives.SortOrder = lvwAscending
End If
.Sorted = True
End With
End Sub

Private Sub Lsv_Archives_ItemCheck(ByVal Item As MSComctlLib.ListItem)
Dim A As Integer
If Item.Checked = True Then
Item.ForeColor = RGB(0, 0, 255)
Item.Bold = True
Me.Cmb_SelectArchives.Visible = True
For A = 1 To Item.ListSubItems.Count
Item.ListSubItems(A).ForeColor = RGB(0, 0, 255)
Item.ListSubItems(A).Bold = True
Next A
Else
Item.ForeColor = RGB(1, 0, 0)
Item.Bold = False
For A = 1 To Item.ListSubItems.Count
Item.ListSubItems(A).ForeColor = RGB(1, 0, 0)
Item.ListSubItems(A).Bold = False
Next A
End If
If Item.Checked = False Then
Me.Cmb_SelectArchives.Visible = False
End If
End Sub

Private Sub InitArchives()
Dim i As Integer
Dim J As Integer
Dim tablo As Variant
Me.Lsv_Archives.Visible = True
With Me.ComboBox1
.Clear
.AddItem "Par N° SIREN"
.AddItem "Par N° Client"
.ListIndex = 0
.Visible = True
End With
Me.Cmb_LancerRecherche.Visible = True
Me.Lbl_Impossible.Visible = False
Me.Cmb_SelectArchives.Visible = False
Me.Lbl_Recherche.Visible = True
Me.Lbl_NbCltsArchives.Visible = True
Me.Lbl_NbCltsTrouves.Visible = False
Me.Txt_NbCltsArchives.Visible = True
Me.Txt_NbCltsTrouves.Visible = False
Me.Txt_No.Visible = True
With Me.Txt_No
.SetFocus
.Value = ""
.Visible = True
End With
With ThisWorkbook.Worksheets("Archives")
tablo = Sheets("Archives").Range("A2😀" & .Range("a65536").End(xlUp).Row)
End With
With Me.Lsv_Archives
With .ColumnHeaders
.Clear
.Add , , "N° du Client", 70
.Add , , "N° Ent.", 50, lvwColumnLeft
.Add , , "N° SIREN", 70, lvwColumnCenter
.Add , , "Nom du Client", 200, lvwColumnLeft
End With
.CheckBoxes = True
.FullRowSelect = True
.Gridlines = True
.LabelEdit = 1
.ListItems.Clear
.MultiSelect = True
.View = lvwReport
End With
With Me.Lsv_Archives
.ListItems.Clear
For i = 1 To UBound(tablo, 1)
.ListItems.Add , , tablo(i, 1)
For J = 2 To UBound(tablo, 2)
If J = 3 Then
.ListItems(i).ListSubItems.Add , , Format(tablo(i, J), "### ### ###")
Else
.ListItems(i).ListSubItems.Add , , tablo(i, J)
End If
Next J
Next i
End With
With Me.Txt_NbCltsArchives
Me.Txt_NbCltsArchives = Lsv_Archives.ListItems.Count - 0
Me.Txt_NbCltsArchives = Format(Me.Txt_NbCltsArchives, "### ##0")
End With
End Sub


J'ai juste Copier/Coller les codes en laissant mes propres références aux contrôles. S'il faut mettre des noms génériques, dites le moi et je le ferais.

J'en profite pour poser deux questions :

1- Dans le code Private Sub Cmb_LancerRecherche_Click() j'ai décidé de gérer le problème de lancement d'une recherche lorsque l'on oublie de saisir un numéro, en basculant sur un message. Ensuite, il n'y a que la possibilité de revenir en arrière ce qui initie de nouveau la Listiew. Est-ce une bonne approche du problème ?

2- Toujours dans le même code, comment appliquer un format spécifique à une colonne ?

Re : Exporter et importer des fichiers

re

tiens tiens, je me demande si j'ai pas m...é en mettant mes pieds dans ce post 😀

à la lecture tres rapide de ton code, j'ai rien vu d'anormal.

si j'ai bien compris ton souci, c'est alimenter des controles d'userform avec des données se trouvant sur un autre fichier, c'est ca ?

pourrais tu nous fournir une pièce jointe (celle qui buggue) ou nous dire les lignes fautives.

salut

Re : Exporter et importer des fichiers

Re

Je vais essayer de m'expiquer clairement.

A la base, mon projet est de créer une base de données adaptée à mon besoin. Débutant et donc sans idée aucune de ce qui m'attendait, je suis donc parti dans l'aventure "La fleur au fusil"... 😀

Dès le début, au lieu de tout fourrer dans un seul et même fichier, j'ai eu la brillante idée de travailler sur des fichiers indépendants correspondants à chacun des Usf, comme si c'était des "sous fichiers".

Je pensais, niaisement, que via Expor/Import dans le VBA que j'allais faire du Copier/Coller, ce qui m'aurait permis de rapatrier chacun des mes "sous fichiers" dans un seul et même fichier général et de disposer ainsi de la base de données tant espérée.

L'histoire ou Excel en a voulu autrement. 😡

Lorsque j'ai utilisé cette fonction d'export puis ouvert un nouveau classeur dans lequel j'ai importé ce que j'avais précedemment exporté et bien, je me suis retrouvé avec des Usf dont les codes ne fonctionnaient plus. Mais plus du tout, rien, que dalle, même pas l'initialisation. 😕

A force de tourner en rond, j'ai envoyé ce post comme une bouteille à la mer.

J'ai désintallé et réinstallé Office (on ne sait jamais) e j'ai aussi reçu des réponses (merci encore à Sylvie, Darnel, Malcy45 et Hervé). 🙂

J'ai avancé un peu vers la solution de mon problème en apprenant qu'il fallait enregistrer les macros mais sur le fond, je uis toujours à côté de la plaque.
En effet, je ne sais toujours pas comment faire pour récupérer mes "sous fichiers" et les rapatrier dans un seul et même fichier.

Voilà, c'est surement du B.A.B pour certains mais pour moi c'est un casse tête de plus.

Re : Exporter et importer des fichiers

Bonjour Papynou, Hervé

petite réflexion toute bête sans doute, à partir de la fenêtre Projet VbaProject, si tu prends tes USF et ou modules avec la souris et que tu fais un déplacer vers un classeur vide logiquement l'USF et les codes associés se copient. Mais j'ai sans doute pas tout compris....

Bon après midi
@+

Re : Exporter et importer des fichiers

Bonjour Pierrot,

Effectivement, tu peux déplacer l'Usf et il se copie bien dans le nouveau classeur. J'avais déjà fait cette manip et vient de la refaire, chez moi ça ne fonctionne pas.

Re : Exporter et importer des fichiers

Bonjour le fil, le forum

A chaque jour suffit sa peine, demain sera un autre jour...

Bon alors la question du jour, pour ce post : est-ce qu'il y a d'autres pistes aujourd'hui ?

Et puis si quelqu'un pouvait répondre à mes questions 1 et 2, ce serait sympa.