Données listview extraction du contenu
Bonjour,
J'ai une listview dans le qu'elle j'affiche des données filtré. j'ai 9 colonne dans cette listview et je voudrais extraire l'intégralité des 9 colonnes et des X lignes dans un autre fichier Excel. C'est à dire que j'obtiendrais un autre fichier avec en feuille1 un tableau avec les même en-tête et même ligne que ce que ma listview affiche.
le listview s'appel LVResut
j'ai bien essayer de tenter cela :
Code:
1
2
3
4
5
6
7
8
9
| Private Sub CommandButton1_Click()
Dim WkNouveau As Workbook, ShNouveau As Worksheet
Set WkNouveau = Workbooks.Add
Set ShNouveau = WkNouveau.Sheets(1)
ShNouveau.Name = "Base"
With ShNouveau
.Cells(1, 1).Resize(LVResult.ListCount, 1).Value = LVResult.Item.list
End With
End Sub |
Mais cela ne fonctionne pas ..
si cela pouvais l'enregistrer à un endroits précis et le fermer automatiquement cela serais formidable.
Cordialement,
Passepartout007
Re : présision du contexte
Bonjour,
Actuellement la listview est alimenter à l'aide d'une macro assez complexe qui tris la base de données, qui est un tableau Excel de plus de 4200 ligne.
La listview peux donc avoir plus de 4200 ligne.
J'aimerais juste que ce qui est afficher dans la listview soit exportable vers un autre ficher quand l'on clic sur un bouton.
Il y a plusieurs type de colonne,
- des colonnes ou l'on retrouver des numéros
- des colonnes ou l'on retrouve du texte
- des colonne ou l'on retrouve des dates
Je ne veux pas que l'exportation se fasse à chaque fois c'est pour cela que je souhaite mettre cette commande sur un bouton.
Voila un peux la situation.
Cordialement,
Passepartout007
Re : quelque petite amélioration
Bonjour,
Je voudrais également qu'il me sorte les columnHerders
j'ai donc effectuer ce code :
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
| Private Sub CommandButton1_Click()
Dim WkNouveau As Workbook, ShNouveau As Worksheet
Dim ligne, colonne As Integer
Set WkNouveau = Workbooks.Add
Set ShNouveau = WkNouveau.Sheets(1)
ShNouveau.Name = "Base"
For colonne = 0 To 8
If colonne = 0 Then
ShNouveau.Cells(1, colonne + 1) = LVResult.ColumnHeader(colonne)
End If
If colonne > 0 Then
ShNouveau.Cells(1, colonne + 1) = LVResult.ColumnHeaders(colonne)
End If
Next colonne
For ligne = 1 To LVResult.ListItems.Count
For colonne = 0 To 8
If colonne = 0 Then
ShNouveau.Cells(ligne + 1, colonne + 1) = LVResult.ListItems(ligne) 'attention changer par rapport avant
End If
If colonne > 0 Then
ShNouveau.Cells(ligne + 1, colonne + 1) = LVResult.ListItems(ligne).ListSubItems(colonne)
End If
Next colonne
Next ligne
End Sub |
Cependant cela ne fonctionne pas, oui on n'arête jamais l'amélioration ^^
Des conseils ?
Cordialement,
Passepartout007
Re: Enregistrement et Mise forme avant enregistrement
Bonjour BoisgontierJacques,
merci pour ton code celui-ci ma beaucoup aider.
voici le nouveau code :
RE-EDITE DU CODE : Cela est effectivement plus rapide
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
| Private Sub CommandButton1_Click()
Dim WkNouveau As Workbook, ShNouveau As Worksheet
Dim ligne, colonne As Integer
Dim Nomfichier As String
Set WkNouveau = Workbooks.Add
Set ShNouveau = WkNouveau.Sheets(1)
ShNouveau.Name = "Extaction"
Dim c As Integer
Dim NbCol As String
Dim nblig As String
NbCol = Me.LVResult.ColumnHeaders.Count
Dim Tbl(): ReDim Tbl(1 To NbCol)
For c = 1 To NbCol
Tbl(c) = Me.LVResult.ColumnHeaders(c)
Next c
[A1].Resize(, NbCol) = Tbl
NbCol = Me.LVResult.ColumnHeaders.Count
nblig = Me.LVResult.ListItems.Count
ReDim Tbl(1 To nblig, 1 To NbCol)
For ligne = 1 To nblig
Tbl(ligne, 1) = LVResult.ListItems(ligne)
For colonne = 1 To Me.LVResult.ColumnHeaders.Count - 1
Tbl(ligne, colonne + 1) = LVResult.ListItems(ligne).ListSubItems(colonne)
Next colonne
Next ligne
[A2].Resize(nblig, NbCol) = Tbl
WkNouveau.ShNouveau.Range("A1:K1").AutoFilter
With WkNouveau.ShNouveau.Range("A1:K1").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Nomfichier = InputBox("Quel est le nom du fichier ?")
'Pour si tu annules, qu'il n'affiche pas le message d'erreur
On Error Resume Next
'Si tu ne changes pas la cellule A1 (le nom), pour éviter le message
'"Un classeur porte déjà ce nom blablabla..."
'On les évite en mettant DisplayAlerts à faux
Application.DisplayAlerts = False
'Ou avec le ThisWorkbook.Path qui est le répertoire du classeur courant.
'C'est à dire qu'il va l'enregistrer dans le même dossier que le classeur qui a cette macro.
WkNouveau.SaveAs Filename:="Bibliothèques\Documents\ " & Nomfichier & ".xlsm"
'Ferme le fichier.
WkNouveau.Close
'Et on remet à vrai le DisplayAlerts
Application.DisplayAlerts = True
End Sub |
Petit problème à partir de la ligne
Code:
WkNouveau.ShNouveau.Range("A1:K1").AutoFilter
il m'indique que la "Propriété ou méthode non gérée par cette objet.
Par la suite tout se passe bien sauf l'enregistrement qui ne veux pas se faire ....
Code:
WkNouveau.SaveAs Filename:="Bibliothèques\Documents\ " & Nomfichier & ".xlsm"
Il passe la ligne sans problème mais n'enregistre pas le fichier ..
par contre il le ferme bien par la suite.
Pouvez vous m'indiquer mes erreur ?
Cordialement,
Passepartout007
