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 79 80 81
| For i = 1 To nbSC
With wdApp.Selection
.Font.Bold = True
.TypeText Text:=RstSC!SC_Numero & " - " & RstSC!PV & " (CB " & RstSC!SC_Code & ")" & _
vbCrLf & vbCrLf
.Font.Bold = False
.TypeText Text:=RstSC!SC_Description & vbCrLf
'photo
If Not IsNull(RstSC!Lien) Then
Dim S As InlineShape
Set S = wdApp.Selection.InlineShapes.AddPicture(RstSC!Lien, False, True)
S.Height = 100
S.Width = 133
End If
.TypeText Text:=vbCrLf & vbCrLf
End With
'insertion tableau P
wdApp.Selection.ParagraphFormat.SpaceBefore = 4
wdApp.Selection.ParagraphFormat.SpaceAfter = 4
wdApp.ActiveDocument.Tables.Add Range:=wdApp.Selection.Range, NumRows:=2, NumColumns:=4, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
With wdApp.Selection.Tables(1)
If .style <> "Grille du tableau" Then .style = "Grille du tableau"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
wdApp.Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
wdApp.Selection.Borders(wdBorderTop).LineStyle = wdLineStyleNone
wdApp.Selection.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
wdApp.Selection.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
wdApp.Selection.MoveRight Unit:=wdCharacter, Count:=2
wdApp.Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
wdApp.Selection.Cells.Merge
wdApp.Selection.Font.Bold = True
wdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wdApp.Selection.TypeText Text:="Entête"
wdApp.Selection.MoveDown Unit:=wdLine, Count:=1
wdApp.Selection.Font.Bold = False
wdApp.Selection.MoveLeft Unit:=wdCharacter, Count:=3
wdApp.Selection.TypeText Text:="col1"
wdApp.Selection.MoveRight Unit:=wdCell
wdApp.Selection.TypeText Text:="Col2"
wdApp.Selection.MoveRight Unit:=wdCell
wdApp.Selection.TypeText Text:="Col3"
wdApp.Selection.MoveRight Unit:=wdCell
wdApp.Selection.TypeText Text:="Col4"
wdApp.Selection.SelectRow
wdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
'Ajout des prelevements
Dim RstPR As DAO.Recordset, nbPR As Long
Set RstPR = dbs.OpenRecordset("SELECT ....;")
RstPR.MoveLast: nbPR = RstPR.RecordCount: RstPR.MoveFirst
For j = 1 To nbPR
'creation new line
wdApp.Selection.MoveDown Unit:=wdLine, Count:=1
wdApp.Selection.InsertRowsAbove 1
'remplissage
wdApp.Selection.TypeText Text:=RstPR!PR_NumeroC: wdApp.Selection.MoveRight Unit:=wdCharacter, Count:=1
wdApp.Selection.TypeText Text:=RstPR!PR_Description: wdApp.Selection.MoveRight Unit:=wdCharacter, Count:=1
wdApp.Selection.TypeText Text:="Positif"
wdApp.Selection.MoveRight Unit:=wdCharacter, Count:=1
wdApp.Selection.TypeText Text:=Nz(RstPR!PR_Interp)
RstPR.MoveNext
Next
wdApp.Selection.Font.Bold = False
wdApp.Selection.MoveDown Unit:=wdLine, Count:=1
wdApp.Selection.TypeText Text:=vbCrLf & vbCrLf & vbCrLf & vbCrLf
wdApp.Selection.MoveEnd
RstSC.MoveNext
Next |
Partager