Salut,
J'ai rajouté une petite fonction pour trouvé Marks dans la plage A43:A47, une boucle suffit, si il ne trouve rien un message avertit l'utilisateur.
Sub ImprimerDansword()
Dim App As Object, Plage As Object
Dim T, I As Byte
Dim C As Range
T = RecupTableau([A43:A47], "MARKS")
If IsArray(T) Then
On Error Resume Next
Set App = GetObject(, "Word.Application")
If Err <> 0 Then Set App = CreateObject("Word.Application")
With App
.Visible = True 'mettre à false pour cacher l'instance une fois les tests finis
.Activate
.documents.Add
With .Selection
For I = 1 To UBound(T)
.TypeText Text:=T(I, 1)
.TypeParagraph
Next I
End With
Set Plage = .activedocument.Range(0, .Selection.End)
Plage.Font.Size = 40
.activedocument.PageSetup.Orientation = 1 'Paysage
'Un exemple chez moi, si tes utilisateurs ont des profils différents, rajouter un userform avec gestion d'utilisateurs.
' Application.SendKeys "^p%n{DOWN}~%o%b{DOWN}~{TAB}{TAB}{TAB}~", True
'Pour le test j'ouvre juste la boit de dialogue imprimer
Application.SendKeys "^p", True
'Une fois imprimer on fermera word sans sauvegarder les modifications du document créé
' .activedocument.Close False
End With
Set Plage = Nothing
Set App = Nothing
Else: MsgBox "Valeur Non trouvée", vbInformation, "Erreur"
End If
End Sub
Function RecupTableau(Plage As Range, Val$)
'La recherche ne tient pas compte de la casse, dernier argument de Instr
Dim C As Range
For Each C In Plage
If InStr(1, C.Value, Val, 1) > 0 Then
RecupTableau = Range(C, C.End(xlDown)).Value 'mettre C.offset(1,0) pour ne pas prendre en compte la cellule contant marks
Exit For
End If
Next C
End Function
A+++