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 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
| Sub general()
Dim shA As Worksheet
Dim wB As Workbook
Set shA = Sheets("x")
Set wB = Workbooks.Open(Filename:="blabla.xlsx")
Dim lastline, lastline2, number, index, diff, produit, nbproduit, index2, boucle As Integer
Dim test As String
'Update les produits du fichier de shipping UPS
lastline = shA.UsedRange.Rows.Count
lastline2 = wB.Sheets(1).UsedRange.Rows.Count
index = lastline2
number = shA.Cells(lastline, 2)
While wB.Sheets(1).Cells(index, 2) <> number
index = index - 1
Wend
wB.Sheets(1).Range("B" & index + 1 & ":F" & lastline2).Copy Destination:=shA.Range("B" & lastline + 1)
wB.Close False
Set wB = Nothing
'On va chercher les produits dans les factures
diff = lastline2 - index
boucle = 1
Dim WordDoc As Word.Document
Dim WordApp As Word.Application
While boucle <> diff
produit = shA.Cells(lastline + 1, 2)
Set WordApp = New Word.Application
WordApp.Visible = False
Set WordDoc = WordApp.Documents.Open("blabla.docx", ReadOnly:=True)
With WordApp
.Selection.WholeStory
.Selection.Copy
End With
Sheets.Add.Name = "tmp"
Set shA2 = Sheets("tmp")
shA2.Range("A1").Select
shA2.Paste
WordApp.Quit
Application.CutCopyMode = False
nbproduit = 1
index2 = 21
shA.Cells(lastline + 1, 9) = shA2.Cells(20, 1)
shA.Cells(lastline + 1, 10) = shA2.Cells(20, 2)
lastline = lastline + 1
While shA2.Cells(index2, 1) <> ""
shA.Cells(lastline + 1, 1).EntireRow.Insert Shift:=xlDown
shA.Cells(lastline + 1, 2) = shA.Cells(lastline + 1 - nbproduit, 2)
shA.Cells(lastline + 1, 2).Interior.Pattern = xlNone
shA.Cells(lastline + 1, 3) = shA.Cells(lastline + 1 - nbproduit, 3)
shA.Cells(lastline + 1, 3).Interior.Pattern = xlNone
shA.Cells(lastline + 1, 4) = shA.Cells(lastline + 1 - nbproduit, 4)
shA.Cells(lastline + 1, 4).Interior.Pattern = xlNone
shA.Cells(lastline + 1, 5).Interior.Pattern = xlNone
shA.Cells(lastline + 1, 9) = shA2.Cells(index2, 1)
shA.Cells(lastline + 1, 10) = shA2.Cells(index2, 2)
lastline = lastline + 1
index2 = index2 + 1
nbproduit = nbproduit + 1
Wend
Set WordDoc = Nothing
Set WordApp = Nothing
Application.DisplayAlerts = False
Sheets("tmp").Delete
Set shA2 = Nothing
boucle = boucle + 1
Wend
Set shA = Nothing
End Sub |
Partager