Probleme transfert listview vers Excel...

Signaler
Messages postés
56
Date d'inscription
dimanche 13 janvier 2002
Statut
Membre
Dernière intervention
8 décembre 2008
-
Messages postés
4
Date d'inscription
vendredi 20 mai 2011
Statut
Membre
Dernière intervention
23 septembre 2012
-
Bonjour à tous amis dévelopeur,
voici mon prbleme,
j'ai une listview qui contiens plusieurs lignes (ca peu varier), je la transfert vers ecxel mais elle me copie que la premiere ligne de ma listview,
pouvez vous getter un oeil sur mon code et me dire comment faire pour copier les autres lignes de la listview dans les cases suivante d'excel?

Voici le code:
Private Sub ExportExcel_Click()
Dim i As Integer
Dim j As Integer

'Chemin du fichier a modifier à chaque installation
repertoire = "C:\fichier.xls"
'Ouverture de l'application
Set appexcel = New Excel.Application
'Gestion du fichier et ouverture statique
appexcel.Workbooks.Open repertoire
'Visualisation en fond d'ecran la page excel
appexcel.Visible = True
'On remplit l'entete de la page excel
appexcel.Worksheets(1).Cells(1, 1).Value = "Date et Heure:"
appexcel.Worksheets(1).Cells(1, 2).Value = "Blanc:"
appexcel.Worksheets(1).Cells(1, 3).Value = "Ciment Blanc:"
appexcel.Worksheets(1).Cells(1, 4).Value = "Ciment Gris:"
appexcel.Worksheets(1).Cells(1, 5).Value = "Concasse:"
appexcel.Worksheets(1).Cells(1, 6).Value = "Filler:"
appexcel.Worksheets(1).Cells(1, 7).Value = "Mi Casse:"
appexcel.Worksheets(1).Cells(1, 8).Value = "Roule:"
appexcel.Worksheets(1).Cells(1, 9).Value = "Silice:"
appexcel.Worksheets(1).Cells(1, 10).Value = "Silice humide:"
appexcel.Worksheets(1).Cells(1, 11).Value = "Vasilogrit:"

appexcel.Worksheets(1).Cells(2 + x, 1).Value = lsvResult.ListItems.Item(1)
appexcel.Worksheets(1).Cells(2, 2).Value = lsvResult.SelectedItem.ListSubItems(1)
appexcel.Worksheets(1).Cells(2, 3).Value = lsvResult.SelectedItem.ListSubItems(2)
appexcel.Worksheets(1).Cells(2, 4).Value = lsvResult.SelectedItem.ListSubItems(3)
appexcel.Worksheets(1).Cells(2, 5).Value = lsvResult.SelectedItem.ListSubItems(4)
appexcel.Worksheets(1).Cells(2, 6).Value = lsvResult.SelectedItem.ListSubItems(5)
appexcel.Worksheets(1).Cells(2, 7).Value = lsvResult.SelectedItem.ListSubItems(6)
appexcel.Worksheets(1).Cells(2, 8).Value = lsvResult.SelectedItem.ListSubItems(7)
appexcel.Worksheets(1).Cells(2, 9).Value = lsvResult.SelectedItem.ListSubItems(8)
appexcel.Worksheets(1).Cells(2, 10).Value = lsvResult.SelectedItem.ListSubItems(9)
appexcel.Worksheets(1).Cells(2, 11).Value = lsvResult.SelectedItem.ListSubItems(11)


For i = 1 To 11

appexcel.Worksheets(1).Cells(1, i).Font.Bold = True
appexcel.Worksheets(1).Cells(1, i).Font.Size = 8
appexcel.Worksheets(1).Cells(1, i).HorizontalAlignment = xlCenter
appexcel.Worksheets(1).Cells(1, i).VerticalAlignment = xlCenter
Next i
For j = 1 To 11
appexcel.Worksheets(1).Cells(2, j).HorizontalAlignment = xlCenter
Next j
End Sub

Merci de me dire comment fair avec un loop par exemple ou autre car je vois pas trop la,
je suis débutant.

Merci d'avance,
Florian.

3 réponses

Messages postés
4
Date d'inscription
vendredi 20 mai 2011
Statut
Membre
Dernière intervention
23 septembre 2012

pensser vous à une bocle
exemlpe:
for i=0 TO LISTVIEW....COUNT-1
appexcel.Worksheets(1).Cells(2 + x, 1).Value = lsvResult.ListItems.Item(1)
appexcel.Worksheets(1).Cells(2, 2).Value = lsvResult.SelectedItem.ListSubItems(1)
appexcel.Worksheets(1).Cells(2, 3).Value = lsvResult.SelectedItem.ListSubItems(2)
appexcel.Worksheets(1).Cells(2, 4).Value = lsvResult.SelectedItem.ListSubItems(3)
appexcel.Worksheets(1).Cells(2, 5).Value = lsvResult.SelectedItem.ListSubItems(4)

EXT I
MERCI
0
Messages postés
4
Date d'inscription
vendredi 20 mai 2011
Statut
Membre
Dernière intervention
23 septembre 2012

VOILLA UN PROGRAMME POUR EXPORTER DONNEES LISTVIEW VERS EXCEL

NOTE: les dernières lignes sont important


Private Sub expo_AGT_EQ_Click()
On Error Resume Next


Dim i As Integer, j As Integer
Dim Application As Application
Dim Cellule As excel.Range

Set Application = excel.Application
Application.Workbooks.Add
Set XCLSheet = Application.Worksheets.Add

Application.Visible = True

'################# entite
' 5 pour commencer de la ligne 5
LineNum = 5

Set Cellule = ActiveSheet.Range(Cells(LineNum, 1), Cells(LineNum, 1))
With Cellule
.Value = "NOM"
.Font.Bold = True
.Font.Size = 8.5
.ColumnWidth = 9
' .HorizontalAlignment = xlCenter
' .VerticalAlignment = xlCenter
End With
Set Cellule = Nothing

Set Cellule = ActiveSheet.Range(Cells(LineNum, 2), Cells(LineNum, 2))
With Cellule
.Value = "PRENOM"
.Font.Bold = True
.Font.Size = 8.5
.ColumnWidth = 9
End With
Set Cellule = Nothing

Set Cellule = ActiveSheet.Range(Cells(LineNum, 3), Cells(LineNum, 3))
With Cellule
.Value = "MATRICULE"
.Font.Bold = True
.Font.Size = 8.5
.ColumnWidth = 9
End With
Set Cellule = Nothing

Set Cellule = ActiveSheet.Range(Cells(LineNum, 4), Cells(LineNum, 4))
With Cellule
.Value = "EQUIPE"
.Font.Bold = True
.Font.Size = 8.5
.ColumnWidth = 9
End With
Set Cellule = Nothing

Set Cellule = ActiveSheet.Range(Cells(LineNum, 16), Cells(LineNum, 16))
With Cellule
.Value = "DATE"
.Font.Bold = True
.Font.Size = 7
.ColumnWidth = 10
End With
Set Cellule = Nothing

'......... tu peux ajouter encors des collone
'.........
'##################### designe des colonnes

' toujours 5 c est la ligne de debit et

For i = 1 To 5
XCLSheet.Cells(4, i).Font.Bold = True
XCLSheet.Cells(4, i).Interior.ColorIndex = 24

XCLSheet.Cells(5, i).Font.Bold = True
XCLSheet.Cells(5, i).Interior.ColorIndex = 24

Next
' ici 11 colonnes
For L = 1 To 11
XCLSheet.Cells(4, L + 5).Font.Bold = True
XCLSheet.Cells(4, L + 5).Interior.ColorIndex = 8

XCLSheet.Cells(5, L + 5).Font.Bold = True
XCLSheet.Cells(5, L + 5).Interior.ColorIndex = 8
Next L

For i = 1 To 16

XCLSheet.Cells(1, i).Font.Bold = True
XCLSheet.Cells(1, i).Interior.ColorIndex = 11
Next

LineNum = LineNum + 1


DForme = LineNum
FForme = LineNum - 1
Set Cellule = ActiveSheet.Range(Cells(1, 1), Cells(1, 16))
Cellule.Borders(xlEdgeTop).LineStyle = xlDouble
Cellule.Borders(xlEdgeBottom).LineStyle = xlDouble
Cellule.Borders(xlEdgeLeft).LineStyle = xlDouble
Cellule.Borders(xlEdgeRight).LineStyle = xlDouble
Set Cellule = Nothing

' important
'###########################
For j = 1 To Listc1.ListItems.Count
For K = 1 To 16
Set Cellule = ActiveSheet.Range(Cells(j + 5, K), Cells(j + 4, K))
Cellule.Borders(xlEdgeLeft).LineStyle = xlContinuous
Cellule.Borders(xlEdgeRight).LineStyle = xlContinuous
Cellule.Borders(xlEdgeBottom).LineStyle = xlContinuous
Set Cellule = Nothing
Next K


XCLSheet.Cells(j + 5, 1) = ListC1.ListItems(j).Text

' XCLSheet.Cells(j + 5, 1) = ListC1.ListItems(j).ListSubItems(15).Text

For i = 1 To ListC1.ColumnHeaders.Count - 1

'######################"""
'Remplire les champs

XCLSheet.Cells(j + 5, i + 1) = ListC1.ListItems(j).ListSubItems(i).Text
Set Cellule = ActiveSheet.Range(Cells(j, 1), Cells(j, 16))
' Cellule.Borders(xlEdgeBottom).LineStyle = xlContinuous
Set Cellule = Nothing

Next i
Next j

'DANS CE PROGRAMME LISTVIEW NOMME LISTC1
BON CHANCE
0
Messages postés
4
Date d'inscription
vendredi 20 mai 2011
Statut
Membre
Dernière intervention
23 septembre 2012

moi j ai trouve un pb est que la valeur de la collone de la date ne transfert pas comme il est.
la valeur du mois prendre la place de jours est et mm pour les jours
veuillez svp de m aide
MERCI
0