Sujet Précédent Sujet Suivant

Probleme transfert listview vers Excel...

florian37 Messages postés 56 Date d'inscription dimanche 13 janvier 2002 Statut Membre Dernière intervention 8 décembre 2008 - 6 sept. 2002 à 00:53
hamid79380J Messages postés 4 Date d'inscription vendredi 20 mai 2011 Statut Membre Dernière intervention 23 septembre 2012 - 23 sept. 2012 à 15:35
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

Réponse 1 / 3
hamid79380J Messages postés 4 Date d'inscription vendredi 20 mai 2011 Statut Membre Dernière intervention 23 septembre 2012
23 sept. 2012 à 15:11
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
Réponse 2 / 3
hamid79380J Messages postés 4 Date d'inscription vendredi 20 mai 2011 Statut Membre Dernière intervention 23 septembre 2012
23 sept. 2012 à 15:30
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
Réponse 3 / 3
hamid79380J Messages postés 4 Date d'inscription vendredi 20 mai 2011 Statut Membre Dernière intervention 23 septembre 2012
23 sept. 2012 à 15:35
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

Discussions similaires

Importation données excel vers access
rahmoun111 -
rach_zar -

2 réponses
EXCEL, faire l'inverse tangente atan pour avoir une valeur en degré minute
wind3813 -
wind3813 -

2 réponses
Calcul sur excel de l'inverse tangente en grade
HERTAN -
ucfoutu -

4 réponses
Faire un copier-coller depuis Excel vers Word via une macro ?
Adoc5 -
bencharqui -

10 réponses
Les fonctions " racines niemmes " et " arctan "et "arccos " et "arcsin"
labriji -
labriji -

6 réponses
Rejoignez-nous