Discussion :

[Dralex]

Salut à tous,

j'ai un problème à vous soumettre car je ne suis qu'un simple débutant en macro...

J'ai une base de donnée Excel. Cette database repertorie des problèmes lorsqu'ils sont pas encore résolus la ligne est rouge, lorsque le problème est résolu la ligne est verte.

Je souhaiterai faire un export de toutes les lignes rouges vers un document word avec une belle mise en page. Là où ça se complique un peu c'est que je n'ai pas besoin de toutes les collones pour cet export !

Pour le moment j'en suis arrivé que a ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
 
Sub EnvoyerDonneesVersWord()
 
     Dim Bam
 
     Set Bam = Workbooks(1).Sheets(2)
 
     InL = Bam.Cells.SpecialCells(xlCellTypeLastCell).Row
 
     InC = Bam.Cells.SpecialCells(xlCellTypeLastCell).Column
 
     Dim DocWord As Word.Document
 
     Dim AppWord As Word.Application
 
     Set AppWord = New Word.Application
 
     Application.DisplayAlerts = True
 
     AppWord.ShowMe
 
     AppWord.Visible = True
 
     'Ouvre le document Word
 
     Set DocWord = AppWord.Documents.Open("\\sibelga.local\TS$\TS_Userdata\EHH398\TC\wec\SuiviWec.doc", ReadOnly:=False)
 
     ' Copie les données Excel
 
     For L = 2 To InL
 
        If (Bam.Cells(L, 1).Interior.ColorIndex = 3) Then
 
            Bam.Range(Cells(L, 1), Cells(L, InC)).Copy
 
        End If
 
      Next
                     ' Colle les données dans Word
 
            DocWord.Range.PasteSpecial
 
            Application.CutCopyMode = False
 
            DocWord.Application.ActiveDocument.Save
 
            AppWord.Application.Quit
 
End Sub

Et ça fait pas du tout ce que j'espère

Merci d'avance pour votre aide

[Philippe Tulliez]

Bonjour,
Je vois un problème dans ta boucle.
Dès que tu vois une cellule dans le format que tu cherches, tu copies la ligne et c'est après la boucle que tu colles dans word donc tu ne peux jamais avoir qu'une seule ligne au collage.
Personnellement, je travaille toujours avec des tableaux complets que je copie dans Excel et ensuite j'utilise les signets de Word pour faire un collagespecial.
Je te donne une solution rapide qui ne me satisfait pas trop mais qui fonctionne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub EnvoyerDonneesVersWord()
  Dim Bam
  Set Bam = Workbooks(1).Sheets(2)
  ' Set Bam = ThisWorkbook.Sheets(2)
  Dim repWrd As String
  Dim InL As Single, InC As Single, L As Single
  InL = Bam.Cells.SpecialCells(xlCellTypeLastCell).Row
  InC = Bam.Cells.SpecialCells(xlCellTypeLastCell).Column
  Dim DocWord As Word.Document
  Dim AppWord As Word.Application
  Set AppWord = New Word.Application
  repWrd = "\\sibelga.local\TS$\TS_Userdata\EHH398\TC\wec\SuiviWec.doc"
  Application.DisplayAlerts = True
  AppWord.ShowMe
  AppWord.Visible = True
  'Ouvre le document Word
  Set DocWord = AppWord.Documents.Open(repWrd, ReadOnly:=False)
  ' Copie les données Excel
  For L = 2 To InL
    If (Bam.Cells(L, 1).Interior.ColorIndex = 3) Then
     Bam.Range(Cells(L, 1), Cells(L, InC)).Copy
     AppWord.Selection.Paste
    End If
  Next
  Application.CutCopyMode = False
  DocWord.Application.ActiveDocument.Save
  AppWord.Application.Quit
End Sub

[Dralex]

C'est déjà beaucoup mieux car tous les enregistrements s'y trouvent mais par contre la mise en page ... comment on peut améliorer ça ? Et comment éviter qu'il ne copie la ligne au complet mais plustot que les collones 1,5,10 de la ligne ?

Merci pour ton aide

[Philippe Tulliez]

Bonjour,
remplacer Inc par 1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Bam.Range(Cells(L, 1), Cells(L, InC)).Copy

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Bam.Range(Cells(L, 1), Cells(L, 1)).Copy

J'ai aussi vu que dans ton code tu fermes l'application Word après la procédure. je te conseille alors de mettre la propriété visible de l'objet AppWord à false.
Tu éviteras ainsi de visualiser ce flash

[Philippe Tulliez]

Bonjour,
Pour la mise en forme, je suppose que c'est propos du motif rouge qui est collé dans word.
Je propose de l'enlever dans excel le temps du copier/coller
Voici cette partie du code modifiée.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
   ' Copie les données Excel
  For L = 2 To InL
    With Bam.Range(Cells(L, 1), Cells(L, 1))
     If .Interior.ColorIndex = 3 Then
     .Interior.ColorIndex = 0
     .Copy
     AppWord.Selection.Paste
     .Interior.ColorIndex = 3
    End If
   End With
  Next

[Dralex]

Bonjour,
remplacer Inc par 1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Bam.Range(Cells(L, 1), Cells(L, InC)).Copy

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Bam.Range(Cells(L, 1), Cells(L, 1)).Copy

J'ai aussi vu que dans ton code tu fermes l'application Word après la procédure. je te conseille alors de mettre la propriété visible de l'objet AppWord à false.
Tu éviteras ainsi de visualiser ce flash

Tu es sûr car du coup il ne copie que la première collone ?

[Philippe Tulliez]

Désolé mais j'avais mal lu la question.
Si tu fais à la main une sélection de cellules non contigües dans excel et que tu fais un coller dans Word. Cela ne fonctionne pas.
Comme je l'ai expliqué je copie des tableaux complets ou des données seules mais toujours avec un adressage à des signets. Là s'arrête mon expérience.
Si j'ai le temps, je me pencherai sur ce problème saus si quelqu'un entretemps trouve la solution.