VBA - Word
Résolu
cs_Hector78
Messages postés
62
Date d'inscription
mercredi 3 novembre 2004
Statut
Membre
Dernière intervention
5 mai 2010
-
2 févr. 2005 à 10:02
cs_Hector78 Messages postés 62 Date d'inscription mercredi 3 novembre 2004 Statut Membre Dernière intervention 5 mai 2010 - 3 févr. 2005 à 07:56
cs_Hector78 Messages postés 62 Date d'inscription mercredi 3 novembre 2004 Statut Membre Dernière intervention 5 mai 2010 - 3 févr. 2005 à 07:56
2 réponses
mrdep1978
Messages postés
402
Date d'inscription
jeudi 25 novembre 2004
Statut
Membre
Dernière intervention
7 juin 2009
7
2 févr. 2005 à 11:27
2 févr. 2005 à 11:27
Ca devrait être un bon début
Public Sub Test()
Dim xlApp As Object
Dim l_Sheet As Object
Dim li_Ligne As Integer
Dim ls_Client As String
Dim ls_Commandes As String
'Crée une instance d'Excel = Lance Excel
Set xlApp = CreateObject("Excel.Application")
'Ouvre le fichier test.xls
xlApp.workbooks.Open "c:\test.xls"
'Travaille avec la feuille Feuil1
Set l_Sheet = xlApp.worksheets("Feuil1")
'Les colonnes A et B contiennent les clients et les commandes
'avec une ligne d'entete
'=> on trie par client par ordre croissant
l_Sheet.Columns("A:B").Sort Key1:=l_Sheet.Range("A2"), _
Order1:=1, _
Header:=1, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=1
'Sélectionne le contenu de tout le document
'Selection.WholeStory
'Supprime tte la zone sélectionnée
'Selection.Delete Unit:=wdCharacter, Count:=1
'Se positionne au début du document
'Selection.HomeKey wdStory
'Parcourt toutes les lignes utilisées de la feuille Excel,
'sauf 1e ligne qui est la ligne de titre
For li_Ligne = 2 To l_Sheet.usedrange.Rows.Count
'Teste si un client est renseigné dans la cellule
If l_Sheet.Cells(li_Ligne, 1).Value <> "" Then
'Teste si on a changé de client
If l_Sheet.Cells(li_Ligne, 1).Value <> ls_Client Then
'Teste si on a déjà passé un client
If ls_Client <> "" Then
'Ecrit le texte Client : Nom_Client à la position du curseur
Selection.TypeText "Client :" & ls_Client
'Saute une ligne
Selection.TypeParagraph
'Ecrit les commandes (on supprime les 2 derniers caractères qui sont ", "
Selection.TypeText "Commandes : " & Left(ls_Commandes, Len(ls_Commandes) - 2)
'Saute une ligne
Selection.TypeParagraph
'Saute une ligne
Selection.TypeParagraph
End If
'Nouveau client
ls_Client = l_Sheet.Cells(li_Ligne, 1).Value
'Réinitialise les commandes
ls_Commandes = ""
End If
'Cumule les commandes
ls_Commandes = ls_Commandes & l_Sheet.Cells(li_Ligne, 2).Value & ", "
End If
Next li_Ligne
'Affiche le dernier client
If ls_Client <> "" Then
Selection.TypeText "Client :" & ls_Client
Selection.TypeParagraph
Selection.TypeText "Commandes : " & Left(ls_Commandes, Len(ls_Commandes) - 2)
Selection.TypeParagraph
Selection.TypeParagraph
End If
'Ferme le fichier test.xls sans sauvegarder les modifs
xlApp.activeworkbook.Close False
'Quitte Excel
xlApp.Quit
'Détruit l'objet Excel
Set xlApp = Nothing
End Sub
Public Sub Test()
Dim xlApp As Object
Dim l_Sheet As Object
Dim li_Ligne As Integer
Dim ls_Client As String
Dim ls_Commandes As String
'Crée une instance d'Excel = Lance Excel
Set xlApp = CreateObject("Excel.Application")
'Ouvre le fichier test.xls
xlApp.workbooks.Open "c:\test.xls"
'Travaille avec la feuille Feuil1
Set l_Sheet = xlApp.worksheets("Feuil1")
'Les colonnes A et B contiennent les clients et les commandes
'avec une ligne d'entete
'=> on trie par client par ordre croissant
l_Sheet.Columns("A:B").Sort Key1:=l_Sheet.Range("A2"), _
Order1:=1, _
Header:=1, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=1
'Sélectionne le contenu de tout le document
'Selection.WholeStory
'Supprime tte la zone sélectionnée
'Selection.Delete Unit:=wdCharacter, Count:=1
'Se positionne au début du document
'Selection.HomeKey wdStory
'Parcourt toutes les lignes utilisées de la feuille Excel,
'sauf 1e ligne qui est la ligne de titre
For li_Ligne = 2 To l_Sheet.usedrange.Rows.Count
'Teste si un client est renseigné dans la cellule
If l_Sheet.Cells(li_Ligne, 1).Value <> "" Then
'Teste si on a changé de client
If l_Sheet.Cells(li_Ligne, 1).Value <> ls_Client Then
'Teste si on a déjà passé un client
If ls_Client <> "" Then
'Ecrit le texte Client : Nom_Client à la position du curseur
Selection.TypeText "Client :" & ls_Client
'Saute une ligne
Selection.TypeParagraph
'Ecrit les commandes (on supprime les 2 derniers caractères qui sont ", "
Selection.TypeText "Commandes : " & Left(ls_Commandes, Len(ls_Commandes) - 2)
'Saute une ligne
Selection.TypeParagraph
'Saute une ligne
Selection.TypeParagraph
End If
'Nouveau client
ls_Client = l_Sheet.Cells(li_Ligne, 1).Value
'Réinitialise les commandes
ls_Commandes = ""
End If
'Cumule les commandes
ls_Commandes = ls_Commandes & l_Sheet.Cells(li_Ligne, 2).Value & ", "
End If
Next li_Ligne
'Affiche le dernier client
If ls_Client <> "" Then
Selection.TypeText "Client :" & ls_Client
Selection.TypeParagraph
Selection.TypeText "Commandes : " & Left(ls_Commandes, Len(ls_Commandes) - 2)
Selection.TypeParagraph
Selection.TypeParagraph
End If
'Ferme le fichier test.xls sans sauvegarder les modifs
xlApp.activeworkbook.Close False
'Quitte Excel
xlApp.Quit
'Détruit l'objet Excel
Set xlApp = Nothing
End Sub
cs_Hector78
Messages postés
62
Date d'inscription
mercredi 3 novembre 2004
Statut
Membre
Dernière intervention
5 mai 2010
3 févr. 2005 à 07:56
3 févr. 2005 à 07:56
Hello !
Merci pour le coup de main !
Bonne journée
Merci pour le coup de main !
Bonne journée
