Attribute VB_Name = "Module2"
Public Type Commandes
    Nomclient As String
    Numérodecommande As String
    Tabvins As String
    Nrdocument As String
End Type

Sub Cherche3()
Dim udtCommandes As Commandes
With udtCommandes
    .Nomclient = ""
    .Numérodecommande = ""
    .Tabvins = ""
    .Nrdocument = ""
End With

Dim R2 As Variant
Dim totrows As Integer
Dim cell As Range

Set sData = Worksheets("Data")
Set sWP = Worksheets("WP")
database = Worksheets("DATA").Range("A1:B500")
totrows = Worksheets("DATA").Range("A1").CurrentRegion.Rows.Count

Range("D1:G50").Select
Selection.Cut Destination:=Range("E1:H50")
Range("E1:H50").Select
Worksheets("WP").Range("D1").value = "Appellation"
Worksheets("WP").Range("D1").value = "Cont."
Worksheets("WP").Range("E1").value = "Marque"
Worksheets("WP").Range("G1").value = "Cart."
Worksheets("WP").Range("H1").value = "NB"
For Each cell In Worksheets("WP").Range("C1:B500")
    On Error Resume Next
        R = Application.WorksheetFunction.VLookup(cell, Worksheets("DATA").Range("A1:B1000"), 2, False)
        R2 = Application.WorksheetFunction.VLookup(cell, Worksheets("DATA").Range("A1:C1000"), 3, False)
        On Error GoTo 0
        If R <> "" Then
            If cell <> R Then
                cell.value = R
                cell.Offset(0, 1).value = R2
            End If
            R = ""
        End If
    Next
    
Range("C1:H50").Select
Selection.Cut Destination:=Range("D1:I50")
Range("I1:I50").Select
Selection.Cut Destination:=Range("C1:C50")

sWP.Range("A1:H500").Select
With Selection.Font
.name = "Calibri"
.Size = 7
End With

sWP.Range("G2:G50").Select
With Selection.Font
.name = "Code39"
.Size = 26

Worksheets("WP").Columns("A:I").AutoFit
Columns("G:G").Select
Selection.ColumnWidth = 21.5

sWP.Range("A1:H50").Borders.LineStyle = xlInsideHorizontal

End With
End Sub
Sub Passage_Excel_Word()
 Dim appWord As New Word.Application
 Dim docWord As New Word.Document
 Dim num As String
 num = Range("A2").value
 Dim name As String
 name = Range("B2").value

' Il faut créer un nouveau document Word dans l'application Word
 With appWord
   .Visible = True
  Set docWord = .Documents.Add
   .Activate
 End With
'Dans Word on ajoute une ligne de titre avec une mise en forme
 With appWord.Selection
   .TypeText Text:="Commande n°"
   .TypeText Text:=num
   .HomeKey Unit:=wdLine
   .EndKey Unit:=wdLine, Extend:=wdExtend
  .ParagraphFormat.Alignment = wdAlignParagraphCenter
   .Font.Size = 18
   With .Font
   .name = "Arial"
   .Size = 24
   .Bold = True
   End With
   

  .EndKey Unit:=wdLine
  .TypeParagraph
  .Font.Size = 12
  .TypeText Text:="Client:"
  .TypeText Text:=name
  .ParagraphFormat.Alignment = wdAlignParagraphLeft
   With .Font
   .name = "Arial"
   .Size = 12
   .Bold = False
   End With

   
'Copier le tableau Excel dans le presse papier
  Range("A1").CurrentRegion.Offset(0, 2).Resize(Range("A1").CurrentRegion.Rows.Count - 1, Range("A1").CurrentRegion.Columns.Count).Copy
' Coller le tableau dans Word avec liaison
 .EndKey Unit:=wdLine
  .TypeParagraph
  .Font.Size = 18
  .PasteSpecial Link:=True, _
 Placement:=wdInLine, DisplayAsIcon:=False
 With .Font
   .name = "Arial"
   .Size = 10
   .Bold = True
   End With
 End With
'Enregistrer le document Word
 With docWord
  .SaveAs ThisWorkbook.Path & "\ca_2003.doc", Allowsubstitutions:=True
'Dans Word Aperçu avant impression du résultat
    .PrintPreview
'Réinitialiser l'objet
  Set appWord = Nothing
 End With
End Sub
Sub Delete()
Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H").Delete
End Sub