Macro pour lancer une impression

Salut,

Je ne conçois pas qu'on veuille et même qu'on puisse convertir des documents texte (.doc) en feuilles de calcul (.xls). Aussi, pensé-je que la première solution est à préférer, d'autant qu'elle ne me semble pas compliquée à implémenter.

Merci pour tes précisions.

Je suis partant pour la 1ère solution par contre je ne sais pas quelle fonction utilisée pour indiquer les documents correspondants en fonction des cellules sélectionnées...

J'ai bien utilisé l'enregistreur de Macro Excel mais il n'enregistre pas les actions que j'ai effectuées pour ouvrir le fichier Word.  

Serait-il possible d'orienter mes recherches ?

Ah, un adepte de l'enregistreur de macro  

Et bien deux solutions :

Utilise-le aussi dans Word pour savoir comment imprimer. Et je t'aiderai à mixer la macro Excel et la macro Word à partir de ce que tu publieras.

Pas la peine d'ouvrir Word pour imprimer : cf. ShellExecute() (API Windows).

Bonjour,

Dans un premier temps, j'essaye de réaliser ce code pour un mode opératoire précis pour voir comment il s'organise.

Voici le code que je peux proposer :

Option Explicit

 
Sub ImpressionMO()

 
Dim ws_annexe1 As Worksheet

 
Set ws_annexe1 = Worksheets("Fiche00")

 
If ws_annexe1.Range("C7") <> "" Then

 
ShellExecute(Handle,"Print","\Mgcesrv01\chantiers\DOSSIER COMMUN\PPSPS MGCE\PPSPS\Fiche Ouvrages\MO 0.00 Les Bonnes Pratiques du Chantier.doc",nil,nil,SW_SHOWDEFAULT)

 
End If

 
Next

 
End Sub

Le souci c'est qu'avec ce code, j'ai un message d'erreur ligne11 "Erreur de compilation : erreur de syntaxe".

Merci d'avance pour votre aide.

Salut,

Bien sûr que tu as une erreur de syntaxe. Tu colles la syntaxe C et tu copies directement en VB. Ça ne fonctionne pas comme ça.
D'abord, VB ne connaît pas les fonctions Windows. Il faut les lui apprendre. Pour cela, on utilise un clause Declare :

Declare Function ShellExecute _
            Lib "shell32.dll" _
          Alias "ShellExecuteA" (ByVal hwnd As Long, _
                                 ByVal lpOperation As String, _
                                 ByVal lpFile As String, _
                                 ByVal lpParameters As String, _
                                 ByVal lpDirectory As String, _
                                 ByVal nShowCmd As Long) As Long

De la même façon, les constantes utilisées par la fonction n'existent pas non plus. Il faut soit les créer, soit utiliser directement leur valeur.
L'API utilise toutes ces constantes : ERROR_BAD_FORMAT, ERROR_FILE_NOT_FOUND, ERROR_PATH_NOT_FOUND, SE_ERR_ACCESSDENIED, SE_ERR_ASSOCINCOMPLETE, SE_ERR_DDEBUSY, SE_ERR_DDEFAIL, SE_ERR_DDETIMEOUT, SE_ERR_DLLNOTFOUND, SE_ERR_FNF, SE_ERR_NOASSOC, SE_ERR_OOM, SE_ERR_PNF, SE_ERR_SHARE, SW_HIDE, SW_MAXIMIZE, SW_MINIMIZE, SW_RESTORE, SW_SHOW, SW_SHOWDEFAULT, SW_SHOWMAXIMIZED, SW_SHOWMINIMIZED, SW_SHOWMINNOACTIVE, SW_SHOWNA, SW_SHOWNOACTIVATE, SW_SHOWNORMAL.
Bon, on définira juste SW_SHOWDEFAULT par principe.

Const SW_SHOWDEFAULT = 10

Et ce handle, à quoi correspond-il ? En général, il s'agit du handle de la fenêtre de l'application, récupérable grâce à la propriété hWnd de l'objet.
En fait, on s'en passera. Ca donne, à l'appel :

ShellExecute 0, "Print", "chemin\mon fichier.doc", vbNullString, vbNullString, SW_SHOWDEFAULT

Ou si tu veux récupérer le code d'erreur :

Dim rc As Long
rc = ShellExecute(0, "Print", "chemin\mon fichier.doc", vbNullString, vbNullString, SW_SHOWDEFAULT)
If rc > 32 Then MsgBox "Doument imprimé"

Bonjour,

Je dois avouer que je suis un peu perdu...

J'ai bien essayé de copier ce code en l'intégrant à la macro précédente mais il m'indique un message d'erreur "Erreur de compilation : Seuls des commentaires peuvent apparaître après End Sub, End Function, ou End Property". Ce message concerne la clause Declare.

J'ai essayé la manip en intégrant ce code dans une autre macro sur le même module et j'ai le même message d'erreur.

Dernier point, j'ai bien consulté l'aide d'Excel mais je ne comprends pas à quoi sert la condition "If rc > 32 Then MsgBox "Document imprimé"". Comment est défini ce 32 ? Est-ce normal qu'on ne mette pas de Enf If puis Next ?

Désolé pour mes lacunes...

Alors un peu de boulot pour toi, avant d'aller plus avant.

Demande l'aide sur le mot Declare. Première phrase, où l'on parle de niveau. Si tu n'y comprends rien, dis-le moi.

Demande l'aide sur le mot If. Rubrique Syntaxe. C'est comme ça, il y a plusieurs syntaxes. C'est moche, mais VB, c'est avant tout du BASIC, un des plus vieux langages de 3ème génération.

Quel Next ?

Relis l'aide sur ShellExecute ( http://msdn.microsoft.com/en-us/library/bb762153%28v=vs... ), rubrique Return Value.

--------------------

Je viens de te faire faire un RTFM      
Dès que tu auras moins d'interrogations, on continuera  

Alors merci pour ces précisions !

Désolé pour la confusion entre le If et le Next...

J'ai donc repris la macro et elle fonctionne pour le MO0.

La voici :

Option Explicit

 
Declare Function ShellExecute _

    Lib "shell32.dll" _

         Alias "ShellExecuteA" (ByVal hwnd As Long, _

                                ByVal lpOperation As String, _

                                ByVal lpFile As String, _

                                ByVal lpParameters As String, _

                                ByVal lpDirectory As String, _

                                ByVal nShowCmd As Long) As Long

 
Sub Impression()

 
Dim ws_annexe1 As Worksheet

Dim rc As Long

 
Const SW_SHOWDEFAULT = 10

 
Set ws_annexe1 = Worksheets("Fiche 00")

 
If ws_annexe1.Range("C7") <> "" Then

 
rc = ShellExecute(0, "Print", "\\Adresse_du_document.doc", vbNullString, vbNullString, SW_SHOWDEFAULT)

If rc > 32 Then MsgBox "Document imprimé"

 
End If

 
End Sub

Maintenant d'autres questions :

Mes cases à cocher se situent en colonne C et J et les noms des fiches correspondantes respectivement en colonne F et M.
Les noms des documents précisés sur la feuille Excel ne sont pas exactement les mêmes que les noms des fichiers mais ils se ressemblent beaucoup (Ex : sur Excel "Installation" et le nom du fichier correspondant "MO 4.30 Installation.doc").

Existe-t-il un moyen pour que la macro parvienne :
- à identifier les noms des documents (en F ou M) pour lesquels on à placé une X (en C ou J) sans que ces documents aient exactement le même nom ?
- à reconnaître le fichier .doc correspondant sans qu'il n'ait nécessairement le même non ?

Ou peut-être vaut-il mieux que je précise pour chaque cellule à quel document elle fait référence ?

Dernière question :
Existe-t-il un moyen pour paramétrer l'impression ? (Recto-Verso, Couleur, Autre imprimante que celle définie par défaut)

Merci encore.

Pas mal. Bon, maintenant, la constante SW_SHOWDEFAULT est intrinsèquement liée à l'API dont les déclarations se font à l'extérieur des fonctions.
Je t'invite donc à ranger la déclaration de cette constante au même endroit que celle de la fonction. (pinaillage)

Je t'en conjure, respecte la sacro-sainte loi de l'Indentation - louée soit-elle.
Ce n'est pas une demande de ma part, c'est une injonction au nom du Dieu Informatique. (mystique)

VBA ne peut pas deviner que deux chaînes de caractères se ressemblent. C'est d'ailleurs très difficile en informatique.
Cela dit, voici quelques éléments de réflexion :

s'affranchir des différences de casse (majuscules/minuscule)

s'affranchir des problèmes d'accents

se baser sur un dénominateur commun à fixer

Admettons que nous aillons installation dans la cellule M1.
Si fname est le nom du fichier, le test suivant est vrai pour le nom de fichier MO 4.30 Installation.doc :

If UCase(fname) Like UCase("*" & Range("M1").Text & "*.doc") Then ..

Citation :

Ou peut-être vaut-il mieux que je précise pour chaque cellule à quel document elle fait référence ?

Voilà une idée, toute bête, toute simple.   Mais qu'est-ce qu'elle est bonne !!!!

Citation :

Existe-t-il un moyen pour ..

T'as demandé à l'enregistreur de macro, juste pour voir ?
Fais une impression Recto. Fais une impression Verso. Compare. Déduis...  

(Y'a juste que tu n'auras pas sauvé la planète en gâchant deux feuilles de papier)

Je viens de faire correspondre chaque cellule aux documents souhaités. Cela mérite déjà des remerciements.

Par contre lorsque j'ai plusieurs documents à imprimer, il m'affiche la fenêtre MsgBox pour chaque document imprimé. Est-il possible d'avoir ce message uniquement à la fin de toutes les impressions ?

Merci d'avance.

Tu veux dire le "Document imprimé" !!!!!?
Ben vire-le.

Je t'ai mis un exemple pour savoir si tout c'est bien passé pour 1.
A toi de voir comment faire pour faire un compte rendu global, avec le nombre de fichiers total, le nombre d'impressions réussies, le nombre d'échecs.

----------------------------------

Euh, je crois que si tu veux passer des paramètres d'impression (recto-verso, changement d'imprimante, couleur/b&w, etc.), la méthode ShellExecute(..,"Print",....) n'est pas la bonne  

Il faut revenir à l'impression par Word. Ça n'est pas plus compliqué, au contraire, mais il faut tout refaire. Pas grave, l'enregistreur de macro va beaucoup nous aider.

J'ai déjà de bonnes idées. Soumets-moi les tiennes, qu'on partage  

Avant de confirmer si je me contente de la solution précédente ou si je me lance dans une macro sous word, pourrais-tu m'indiquer si une de ces 2 solutions (ou peut-être les 2) est envisageable sans que l'on ait la fenêtre de Word qui s'ouvre avec le document correspondant ? Ou tout du moins la fenêtre qui s'affiche à l'écran.

J'ai essayé de le paramétrer dans la macro en remplaçant le paramètre SW_SHOWDEFAULT par un SW_HIDE mais je n'y suis pas parvenu. J'ai déclaré la Constante de cette manière :

Const SW_HIDE = 0

Merci d'avance.

Partons sur l'idée d'une macro Word.
Avec l'aide de l'enregistreur, tu me fais une macro VBA/Word pour imprimer un document recto-verso en couleurs et paysage, et je te montre comment en faire une macro VBA/Excel qui n'ouvre pas de fenêtre Word et qui t'imprime tous les documents que tu veux.

Sympa le deal ?  

Alors voici la macro que j'ai à te proposer (réalisée avec l'enregistreur):

Option Explicit

Sub Macro1()

 
ActivePrinter = "\\192.168.4.6\Ricoh Couleur"

Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _

    wdPrintDocumentContent, Copies:=1, PageType:= _

    wdPrintAllPages, ManualDuplexPrint:=False, Collate:=True, Background:= _

    True, PrintToFile:=False, PrintZoomColumn:=0, PrintZoomRow:=0, _

    PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0

 
End Sub

Déroulé de la macro :
- Je sélectionne l'imprimante couleur qui n'est pas celle par défaut,
- J'ai demandé une impression recto-verso.

La feuille est par défaut en paysage, j'ai juste modifié le sens de rotation (sur la gauche au lieu de par le haut).

Merci encore pour tes précieux conseils.

Bon alors on va surtout pas commencer à s'énerver sur les paramètres spécifiques de ton imprimante, genre le recto-verso par exemple. C'est un peu compliqué. Mais on pourra y revenir si tu veux.

En attendant, concentrons-nous sur ton code.

Moi, j'observe une propriété - ActivePrinter - et une méthode - PrintOut(). Et je demande l'aide de VBA/Word.
Concernant ActivePrinter, c'est trivial. Quant à PrintOut(), ce qui est intéressant, c'est que c'est aussi une méthode de l'objet Document.

Alors voilà ce que je propose : on va ouvrir un Word, y charger uns à uns tous nos documents, les imprimer au fur et à mesure, puis fermer Word, tout ça à partir d'Excel.
On y va ?

Dim appWord As Object ' // Par défaut, Excel ne connaît pas les objets Word.
Dim docWord As Object ' // Restons vague ~~~~
 
' // Instancier Word
Set appWord = CreateObject("Word.Application")
appWord.ActivePrinter = "ton imprimante"
 
For Each nom_du_fichier In [Il faut ici parcourir les noms de fichiers que tu veux imprimer !]
    Set docWord = appWord.Documents.Open(nom_du_fichier, ReadOnly:=True)
    docWord.PrintOut ' // <-- Impression
    docWord.Close SaveChanges:=False
Next
 
appWord.Quit

Avant de me lancer dans la rédaction, j'ai quelques soucis de compréhension sur certains termes.  

Qu'entends-tu par "charger uns à uns tous nos documents" ? Il doit tous les charger ou uniquement ceux sélectionnés ?

2e point : dans le code de la macro tu me parles de "parcourir les noms des fichiers". Cela signifie-t-il que je dois le compéter pour nom de chaque fichier ? Ou peut-être veux-tu dire qu'il faut que je copie le chemin pour chaque fichier ?

Peut-être que je veux aller plus vite que la musique en souhaitant imprimer uniquement les documents sélectionnées...

Merci pour tes précisions.

Voici le code que j'ai adapté pour un seul fichier

Option Explicit

 
Sub Impression2()

 
Dim appWord As Object ' // Par défaut, Excel ne connaît pas les objets Word.

Dim docWord As Object ' // Restons vague ~~~~

Dim ws_annexe1 As Worksheet

Dim Cell As Range

 
Set appWord = CreateObject("Word.Application")

appWord.ActivePrinter = "\\192.168.4.6\Ricoh Couleur"

Set ws_annexe1 = Worksheets("Fiche 00")

 
For Each Cell In ws_annexe1.Range("C7") '[Il faut ici parcourir les noms de fichiers que tu veux imprimer !]

    If Cell <> "" Then

    Set docWord = appWord.Documents.Open("\\chemin_du_fichier.doc", ReadOnly:=True)

    docWord.PrintOut ' // <-- Impression

    docWord.Close SaveChanges:=False

 
End If

 
Next

 
appWord.Close

 
End Sub

Dans l'état actuel des choses, il m'imprime le document en couleur sur l'imprimante choisie.

Par contre, j'ai un débogage sur la ligne24 "Erreur d'exécution '438' : Propriété ou méthode non gérée par cet objet".

Pour la suite, je dois réitérer cette procédure pour chaque document ?

Merci.

M'enfin !

Relis mon code  

For Each Cell In ws_annexe1.Range("C7" )

Ah bon ? T'avais pas des X dans des cases, toussa ????

appWord.Documents.Open("\\chemin_du_fichier.doc", ...

Ah bon ? T'avais pas des noms de fichiers dans des cases, toussa ????

Pour la 1ère remarque :

For Each Cell In ws_annexe1.Range("C:C", "F:F")

If Cell = "X"

Pour la 2ème remarque :

Ce n'est pas le nom exact des fichiers comme je l'avais précisé précédemment.
Je ne vois pas comment il peut retrouver le chemin sans lien hypertexte. A moins que je n'ai pas compris le principe du code, ce qui est également possible...

Je poursuis mes recherches quand même.

Bon. Arrête de ramer, le barreur de la galère te fait tourner en rond !!!  

Bon, alors en fait ta feuille Excel est organisée en deux grosses colonnes, C-F & J-M. (Faut donc le deviner   )
Tu as des X dans les colonnes C et J, et des noms de fichiers dans les colonnes F et M.

Pour ne pas avoir 65536 lignes à vérifier, on va chercher quelle est la dernière ligne non vide de ta feuille.

Dim ws      As Worksheet
Dim lastrow As Range
Dim row     As Range
Dim i       As Integer ' // Gauche/Droite
 
Set ws = ?????????? ' // <- ta feuille
Set lastrow = ws.rows( _
    WorksheetFunction.Max( _
        ws.Columns("C").Cells(65536).End(xlUp).row, _
        ws.Columns("J").Cells(65536).End(xlUp).row, _
        ws.Columns("F").Cells(65536).End(xlUp).row, _
        ws.Columns("M").Cells(65536).End(xlUp).row))

Maintenant on va parcourir toutes les lignes, de la première à celle qu'on vient de trouver

For Each row In ws.Range(ws.rows(1), lastrow).rows

Et on va regarder un coup à gauche, un coup à droite :

For i = 0 To 1

Quand i est égal à 0, il faut considérer les colonnes C(3) et F(6), et quand i est égal à 1, ce sont les colonnes J(10) et M(13).
Après un peu de réflexion, le numéro de colonne pour C et J est 7i+3, et pour F et M, 7i+6.

If row.Cells(7 * i + 3).Text = "X" Then imprime_doc row.Cells(7 * i + 6).Text, appWord

Bon, evidemment, ça ne marchera que quand on aura instancié appWord et inventé imprime_doc. Voici :

Sub imprime_doc(fname As String, appWord As Object)
    Dim docWord As Object
 
    Set docWord = appWord.Documents.Open(fname, ReadOnly:=True)
    docWord.PrintOut
    docWord.Close SaveChanges:=False
End Sub

Bon, ça c'est si les colonnes F et M contiennent des noms de fichiers avec leur chemin.



Gardons imprime_doc(fname As String, appWord As Object) mais appelons dans le If row.Cells(7 * i + 3).Text = "X" Then une autre fonction, disons imprime_doc_nom_approximatif(fapproxname As String, appWord As Object)  

Sub imprime_doc_nom_approximatif(fapproxname As String, appWord As Object)
    Dim fname As String
 
    ' // trouver une corrélation entre fapproxname, récupéré de F ou M, et le nom du fichier sur le disque
    fname = ?? fapproxname ??
 
    imprime_doc fname, appWord
End Sub

Je relance la réalisation de cette macro.

J'ai bien pris connaissance du code et je t'en remercie par contre pour la corrélation entre le fapproxname et le fname, elle est différente pour chaque fichier, cela signifie-t-il qu'il faille la préciser pour chaque ?

C'est pourquoi une autre solution me semble intéressante, tu risques de me dire que j'ai encore changé d'avis mais je pense que cela va faciliter les choses.

En fait plutôt que de se baser sur le nom approximatif des fichiers situés dans les colonnes F et M, j'ai dans les colonnes E et L des n° de procédures du type (0.00 ou 4.15) qui sont repris à chaque fois dans le nom de fichier Word ("MO 0.00 XXX.doc" ou "MO 4.15 HSHS.doc") .

Je suppose qu'il existe un moyen pour que dans la macro, le code indiqué sur ces colonnes soient retrouvés dans le début du nom des fichiers.

Pour la première partie du code, les modifications sont minimes, il doit me suffire de remplacer 7i+3 par 7i+2 et 7i+6 par 7i+5 par contre il faut quand même faire la corrélation entre le code dans la colonne E ou L et le début du nom du fichier.

Encore merci.

 

Je ne vois pas bien le début et la fin de tes noms de fichiers dans tes exemples. Mais bon. Relis l'aide sur Like que je t'ai déjà proposé, je crois que c'est ce qu'il te faut.

Pour faire avancer les choses, voici la macro (qui ne fonctionne pas même si je n'ai pas de message d'erreur)...

Option Explicit

 
Sub Impression3()

 
Dim ws_mo   As Worksheet

Dim lastrow As Range

Dim row     As Range

Dim i       As Integer ' // Gauche/Droite

Dim appWord As Object

Dim docWord As Object

 
Set ws_mo = Worksheets("Fiche 00") ' // <- ta feuille

Set lastrow = ws_mo.Rows(WorksheetFunction.Max( _

                                          ws_mo.Columns("C").Cells(65536).End(xlUp).row, _

                                          ws_mo.Columns("J").Cells(65536).End(xlUp).row, _

                                          ws_mo.Columns("E").Cells(65536).End(xlUp).row, _

                                          ws_mo.Columns("L").Cells(65536).End(xlUp).row)) _

 
Set appWord = CreateObject("Word.Application")

appWord.ActivePrinter = "\\192.168.4.6\Ricoh Couleur"

 
For Each row In ws_mo.Range(ws_mo.Rows(1), lastrow).Rows

For i = 0 To 1

    If row.Cells(7 * i + 2).Text = "X" Then

            imprime_doc row.Cells(7 * i + 5).Text, appWord

    End If

Next

Next

 
End Sub

 
Sub imprime_doc(fname As String, appWord As Object)

 
Dim docWord As Object

 
Set docWord = appWord.Documents.Open(fname, ReadOnly:=True)

 
If UCase(fname) Like UCase("*" & Range("E,L").Text & "*.doc") Then

      docWord.PrintOut

      docWord.Close SaveChanges:=False

 
End If

 
appWord.Quit

 
End Sub

J'ai bien lu l'aide sur la fonction Like mais je ne vois pas comment, en l'état actuel des choses, la macro peut-elle aller chercher les différents fichiers étant donné qu'aucun chemin n'est précisé vers le dossier les regroupant.

Cette fonction permet-elle de faire la recherche de fichiers dans l'ensemble ou faudra-t-il faire la recherche pour chaque fichier ?

Indente tes lignes 25, 40 et 41.....
(cependant que je regarde ton code)

row.Cells(7 * i + 5).Text ne contient pas un nom de fichier. Donc on ne peut pas l'utiliser directement avec imprime_doc(fname, appWord) qui attend un nom de fichier.
Donc il faut rechercher le nom du fichier juste avant.

Soit la fonction suivante :

Function nom_doc(nompartiel As String) As String

    Dim FSO As New FileSystemObject

    Dim dir As Folder

    Dim ref As File

 
    Set dir = FSO.GetFolder("C:\")

    For Each ref In dir.Files

        If ref.Name Like "*" & code & "*.doc" Then

            nom_doc = ref.Path

            Exit For

        End If

    Next

End Function

Il reste à l'appeler :

imprime_doc nom_doc(row.Cells(7 * i + 5).Text), appWord

Reste que la gestion des erreurs (fichier introuvable notamment) n'est pas faite.

Voici le code que je peux proposer :

Option Explicit

 
Sub Impression3()

 
Dim ws_mo   As Worksheet

Dim lastrow As Range

Dim row     As Range

Dim i       As Integer ' // Gauche/Droite

Dim appWord As Object

Dim docWord As Object

 
Set ws_mo = Worksheets("Fiche MO Construction") ' // <- ta feuille

Set lastrow = ws_mo.Rows(WorksheetFunction.Max(ws_mo.Columns("C").Cells(65536).End(xlUp).row, ws_mo.Columns("J").Cells(65536).End(xlUp).row, ws_mo.Columns("E").Cells(65536).End(xlUp).row, ws_mo.Columns("L").Cells(65536).End(xlUp).row))

Set appWord = CreateObject("Word.Application")

appWord.ActivePrinter = "\\192.168.4.6\Ricoh Couleur"

 
For Each row In ws_mo.Range(ws_mo.Rows(1), lastrow).Rows

For i = 0 To 1

    If row.Cells(7 * i + 2).Text = "X" Then

    imprime_doc nom_doc(row.Cells(7 * i + 5).Text), appWord

    End If

Next

Next

 
End Sub

 
Function nom_doc(nompartiel As String) As String

 
Dim FSO As New FileSystemObject

Dim dir As Folder

Dim ref As File

 
Set dir = FSO.GetFolder("C:\MO\")

 
For Each ref In dir.Files

    If ref.Name Like "*" & code & "*.doc" Then

        nom_doc = ref.Path

            Else: MsgBox ("Mode opératoire introuvable")

        Exit For

    End If

Next

 
End Function

 
Sub imprime_doc(fname As String, appWord As Object)

 
Dim docWord As Object

 
Set docWord = appWord.Documents.Open(fname, ReadOnly:=True)

 
If UCase(fname) Like UCase("*" & Range("E,L").Text & "*.doc") Then

    docWord.PrintOut

    docWord.Close SaveChanges:=False

End If

 
appWord.Quit

 
End Sub

Toujours pas de message d'erreur mais aucune impression ne se lance...

J'ai intégré une MsgBox si le fichier est introuvable, à confirmer que je l'ai mise au bon endroit et qu'elle est correctement rédigée.

Salut,

Ah non, la boîte n'est pas au bon endroit. Admettons que tu aies n fichiers. Si le dernier est le bon, tu vas avoir n-1 messages.

Je réécris la fonction, parce qu'on pouvait faire mieux (c'est subtil) :

Function nom_doc(nompartiel As String) As String

    Dim FSO As New FileSystemObject

    Dim dir As Folder

    Dim ref As File

 
    nom_doc = ""

    Set dir = FSO.GetFolder("C:\" )

    For Each ref In dir.Files

        If ref.Name Like "*" & code & "*.doc" Then

            nom_doc = ref.Path

            Exit Function

        End If

    Next

End Function

Dim fname As String

For Each row In ws_mo.Range(ws_mo.Rows(1), lastrow).Rows

    For i = 0 To 1

        If row.Cells(7 * i + 2).Text = "X" Then

            fname = nom_doc(row.Cells(7 * i + 5).Text)

            If fname = "" Then

                MsgBox "DEBUG - Document """ & row.Cells(7 * i + 5).Text & """ introuvable."

            Else

                imprime_doc fname, appWord

            End If

        End If

    Next

Next

Allez, mets-toi des MsgBox "DEBUG - ..." partout....

Je dois avouer qu'avec ce code je suis un peu perdu...

Pour l'instant, j'ai essayé de l'adapter mais ça ne fonctionne pas et je n'ai pas de message d'erreur.

Ma question est la suivante : un code est-il suffisant pour l'ensemble des documents ou dois-je adapter ce code pour chaque document ?

Merci d'avance pour votre aide.

EDIT : partant du principe que ce code permet d'identifier les documents dans le dossier, voici le code que j'ai à proposer :

Option Explicit

 
Sub Impression3()

 
Dim ws_mo   As Worksheet

Dim lastrow As Range

Dim row     As Range

Dim i       As Integer ' // Gauche/Droite

Dim appWord As Object

Dim docWord As Object

Dim fname As String

 
Set ws_mo = Worksheets("Fiche MO Construction") ' // <- ta feuille

Set lastrow = ws_mo.Rows(WorksheetFunction.Max(ws_mo.Columns("C").Cells(65536).End(xlUp).row, ws_mo.Columns("J").Cells(65536).End(xlUp).row, ws_mo.Columns("E").Cells(65536).End(xlUp).row, ws_mo.Columns("L").Cells(65536).End(xlUp).row))

Set appWord = CreateObject("Word.Application")

appWord.ActivePrinter = "\\192.168.4.6\Ricoh Couleur"

 
For Each row In ws_mo.Range(ws_mo.Rows(1), lastrow).Rows

    For i = 0 To 1

        If row.Cells(7 * i + 2).Text = "X" Then

            fname = nom_doc(row.Cells(7 * i + 5).Text)

            If fname = "" Then

                MsgBox "DEBUG - Document """ & row.Cells(7 * i + 5).Text & """ introuvable."

            Else

                imprime_doc fname, appWord

            End If

        End If

    Next

Next

 
End Sub

 
Function nom_doc(nompartiel As String) As String

 
    Dim FSO As New FileSystemObject

    Dim dir As Folder

    Dim ref As File

 
    nom_doc = ""

    Set dir = FSO.GetFolder("C:\MO\")

    For Each ref In dir.Files

        If ref.Name Like "*" & code & "*.doc" Then

            nom_doc = ref.Path

            If nom_doc = "" Then

                MsgBox "DEBUG - Document """ & row.Cells(7 * i + 5).Text & """ introuvable."

            Else

                Exit Function

            End If

        End If

    Next

 
End Function

 
Sub imprime_doc(fname As String, appWord As Object)

 
Dim docWord As Object

 
Set docWord = appWord.Documents.Open(fname, ReadOnly:=True)

 
If UCase(fname) Like UCase("*" & Range("E,L").Text & "*.doc") Then

    docWord.PrintOut

    docWord.Close SaveChanges:=False

End If

 
appWord.Quit

 
End Sub

EDIT : je viens de m'apercevoir que cette macro modifie mon imprimante par défaut dans windows, je préférerai qu'elle soit juste définie comme imprimante par défaut pour l'impression de ces documents.

Je me permets de "remonter" ce sujet car malgré différentes tentatives je suis toujours bloqué avec cette macro.

Merci d'avance à toute personne pouvant m'indiquer les modifications à apporter...

Rholalal, je viens de relire ton code. C'est du grand n'importe quoi !!

Function nom_doc(nompartiel As String) As String

 
    Dim FSO As New FileSystemObject

    Dim dir As Folder

    Dim ref As File

 
    nom_doc = ""

    Set dir = FSO.GetFolder("C:\MO\" )

    For Each ref In dir.Files

        If ref.Name Like "*" & code & "*.doc" Then

            nom_doc = ref.Path

            If nom_doc = "" Then

                MsgBox "DEBUG - Document """ & row.Cells(7 * i + 5).Text & """ introuvable."

            Else

                Exit Function

            End If

        End If

    Next

 
End Function

Quand tu écris nom_doc = ref.Path, c'est la valeur de la fonction qui est affectée.
Quand tu écris If nom_doc = "" Then, c'est la fonction nom_doc() qui est appelée à l'interieur d'elle-même.
En plus ce test est idiot. Tu sais qu'il y a quelque chose dedans puisque tu viens de l'y mettre !

Réécris-ça.

Bonjour,

Je suis toujours sur la mise au point de cette macro et je bloque sur la remarque nom_doc = ref.Path  

J'ai consulté l'aide sans grand succès et je ne parviens toujours pas à comprendre ce que je dois modifier.

Je n'ai aucun message d'erreur et pourtant aucune impression ne se lance.

Merci d'avance.