Macro ; imprimer sur 3 imprimantes réseaux à la fois

Bonjour à tous,

Dans la procédure que nous mettons en place en cas d'incendie, je mets en place une macro qui me sort sur l'imprimante 1 la liste triée par catégorie de famille professionnelle et des visiteurs aussi, de toutes les personnes présentes. Le responsable incendie me demande de compléter en faisant imprimer la liste sur les trois imprimantes de la maison. Ainsi chaque secteur aura une liste pour vérifier si tout le monde est sortit du bâtiment pour se mettre sur les lieux prévus.

Seulement, je n'arrive pas à écrire ma macro. Il me prend l’imprimante par défaut. Et je ne evux pas choisir les imprimantes à la main. Il faut que ça sorte automatiquement et vite, car je suis en même temps responsable de la gestion de l'alarme.

Mes imprimantes se nomment : Mopieur01 - Mopieur02 et Admin.Laser

Pouvez-vous me dire comment écrire ça svp:

Milles mercis

Ma macro

Sub PresenceSecours()
'
' PresenceSecours Macro
' Sélectionne, copie, colle, trie et imprime les présents
'

'
    ActiveSheet.Range("$C$1:$C$127").AutoFilter Field:=1, Criteria1:="Présent"
    Range("A4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range("A4:B93").Select
    Selection.Copy
    Sheets("PRESENCES SECOURS").Select
    Range("A1").Select
    ActiveSheet.Paste
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    Selection.Font.Bold = False
    With Selection.Font
        .Name = "Corbel"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Columns("B:B").EntireColumn.AutoFit
    ActiveWorkbook.Worksheets("PRESENCES SECOURS").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("PRESENCES SECOURS").Sort.SortFields.Add Key:=Range _
        ("A1:A26"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("PRESENCES SECOURS").Sort.SortFields.Add Key:=Range _
        ("B1:B26"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("PRESENCES SECOURS").Sort
        .SetRange Range("A1:B26")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
       Range("A1").Select
End Sub

Bonjour Serji

Essaye ce code optimisé avec recherche du nom de l'imprimante et de son port

Sub PresenceSecours()
  Dim DLig As Long, DefaultPrinter As Variant
  '
  ' PresenceSecours Macro
  ' Sélectionne, copie, colle, trie et imprime les présents
  '
  ' Avec la feuille active
  With ActiveSheet
    ' Supprimer le filtre existant
    .Range("$C$1").AutoFilter
    ' On applique un filtre
    .Range("$C$1").AutoFilter Field:=3, Criteria1:="Présent"
    ' On récupère le numéro de la dernière ligne
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' On copie l'ensemble des lignes filtrées vers la feuille de présence
    .Range("A4:B" & DLig).Copy Destination:=Sheets("PRESENCES SECOURS").Range("A1")
  End With
  ' Avec la feuille de présence
  With Sheets("PRESENCES SECOURS")
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    With .Cells.Font
      .Name = "Corbel"
      .Size = 16
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .ColorIndex = xlAutomatic
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With
    .Columns("B:B").EntireColumn.AutoFit
    With .Sort
      .SortFields.Clear
      .SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending
      .SortFields.Add Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending
      .SetRange Range("A1:B" & DLig)
      .Header = xlGuess
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
Suite:
    ' Mémoriser l'imprimante par défaut actuelle
    DefaultPrinter = Application.ActivePrinter
    ' Mes imprimantes se nomment : Mopieur01 - Mopieur02 et Admin.Laser
    .PrintOut Copies:=1, ActivePrinter:=NomImpAvecPort("Mopieur01"), Collate:=True, IgnorePrintAreas:=False
    .PrintOut Copies:=1, ActivePrinter:=NomImpAvecPort("Mopieur02"), Collate:=True, IgnorePrintAreas:=False
    .PrintOut Copies:=1, ActivePrinter:=NomImpAvecPort("Admin.Laser"), Collate:=True, IgnorePrintAreas:=False
    ' Remettre l'imprimante par défaut
    Application.ActivePrinter = DefaultPrinter
  End With
End Sub

Function NomImpAvecPort(sName As String)
  Dim b As Integer, sImp As String
  For b = 0 To 9
    Err.Clear
    sImp = sName & " sur Ne0" & b & ":"
    On Error Resume Next
    Application.ActivePrinter = sImp
    If Err.Number = 0 Then
      NomImpAvecPort = sImp
      On Error GoTo 0
      Exit For
    End If
  Next
End Function

A+

Bonjour Bruno,

Merci pour votre aide précieuse.

Malheureusement, ça m'a donné une feuille "Présences Secours" vide avec juste deux cellules de couleurs (entête de mon fichier) et la feuille de présence (source des données) est vide aussi, avec des filtres automatiques à chaque colonne. Lorsque je sélectionne dans ces filtres "sélectionner tout" le fichier reste vide.

Alors j'ai remis la macro que j'ai faites et mis en fin

 ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:=NomImpAvecPort("MOPIEUR01"), Collate:=True, IgnorePrintAreas:=False
       [b] ActiveWindow.SelectedSheets[/b].PrintOut Copies:=1, ActivePrinter:=NomImpAvecPort("MOPIEUR02"), Collate:=True, IgnorePrintAreas:=False
        [b]ActiveWindow.SelectedSheets[/b].PrintOut Copies:=1, ActivePrinter:=NomImpAvecPort("ADMIN-LASER"), Collate:=True, IgnorePrintAreas:=False
           Range("A1").Select
           ' Remettre l'imprimante par défaut
       Application.ActivePrinter = DefaultPrinter

J'ai rajouter "ActiveWindow.SelectedSheets" pour chaque imprimante parce que ça buguait sans. Seulement à présent, ça marche, il me sort trois copies, mais les trois sur la même imprimante, le mopieur1

Peut-être aimeriez-vous un fichier d'exemple ? Si oui, je devrais en anonymiser un. C'est certainement la construction de mon fichier qui bloque votre macro.

milles mercis pour votre support

Cordialement

Serji

Bonjour Serji,

Merci effectivement de nous adresser un fichier avec quelques lignes

A+

Bonjour Bruno

Alors voici un fichier avec les deux macros ; la votre bien sûr et celle que j'ai bidouillé en mélangeant les deux (patapé)

La votre, en tout cas sur mon poste, agit comme dit supra. Mais je suis sur que c'est le montage de mon fichier.

La mienne, sort la liste comme avant, mais imprime 3 copies sur mopieur1.

Merci de prendre du temps pour m'aider

Cordialement

Serji

Re,

Le problème vient du fait que la mention "Présent" est dans la colonne D soit la 4ème colonne

Le filtre était appliqué à la 3ème "Field:=3"

Voici le fichier modifié avec un joli petit bouton en prime

A+

Merci Bruno,

Et chic, j'ai un joli bouton, c'est sympa, tout bleu comme les feux bleus, bien vu !

Sinon ça fonctionne du tonnerre à l'exception de l'impression des 3 exemplaires qui perdure sur mon mopieur 1 uniquement. C'est curieux. Je me demande si ce n'est pas du au réseaux lui-même. Mais du coup ça me dépasse, déjà que...

Si vous avez une piste j'en serais ravi. Sinon, je vais tenter de me tourner vers les gars du réseaux peut-être, qu'en pensez-vous ?

Cordialement

Serji

Re,

Pour vérifier, mets l'imprimante "Mopieur02" en imprimante par défaut

Ensuite dans VBA project dans la fenêtre d'exécution tu saisies

Debug.Print Application.ActivePrinter

puis entrée

Donne nous le résultat qui apparait

A+

Mopieur2 sélcetionné comme imprimante par défaut

J'exécute le code que vous m'avez donné et :

Debug.Print Application.ActivePrinter
\\PRNTOLPAN01\MOPIEUR01 sur Ne04:

Du coup j'ai rigolé comprenant que quoi qu'on fasse, c'est mopieur1 qui sort grmblll... c'est ça ?

AJOUT :

J'ai refais le test avec Admin-Laser, j'obtiens le même résultat

Re,

C'est peut-être bien ça

J'ai quand même changé mon code pour activer la bonne imprimante, teste le nouveau fichier

Sinon, pour régler ton soucis (peut-être)

1) dans l'explorateur windows tu vas sur ton serveur qui gère les impressions

\\PRNTOLPAN01

2) tu fais un clique droit sur ton imprimante "Mopieur2" -> Connecter

Même chose pour la 3ème

A+

Mmmm... mauvaise nouvelle. Pour ça je dois contacter l'administrateur réseaux je crois, car je ne trouve pas la commande, ni ne vois dans les proprités des imprimantes une option "connecter" hélas. Les admins réseaux ils ont durs à gérer je vais donc attendre le retour du boss et il s'en occupera.

A ce stade, est-ce qu'il serait raisonnable de faire 2 autres macros, une pour mopieur2 et une pour admin-laser et les mettre dans la macro que vous m'avez concocté ?

Re,

Avant toute chose (comme indiqué), as-tu testé le fichier que je t'ai mis dans le post précédent !?

https://forum.excel-pratique.com/excel/macro-imprimer-sur-3-imprimantes-reseaux-a-la-fois-t66011.html#p375114

A+

BrunoM45 a écrit :

Re,

Avant toute chose (comme indiqué), as-tu testé le fichier que je t'ai mis dans le post précédent !?

https://forum.excel-pratique.com/excel/macro-imprimer-sur-3-imprimantes-reseaux-a-la-fois-t66011.html#p375114

A+

Ooops... je ne l'avais même pas vu, désolé. Une fin de journée difficile a eu raison de mes neurones et j'étais rester sur cette histoire d'imprimante à configurer en "connecté". Je ne pourrais tester ton fichier que lundi. Pas de boulot pour moi ces 4 prochains jours et comme tu sais, ici, mac et pas d'excel

Merci encore pour le temps que tu prends à m'aider.

en te souhaitant une agréable fin de semaine

Avec mes meilleurs messages

Serji

Bruno dans mes bras !!!

Tu mérites une statut ! ça marche du tonner c'est tout simplement génial.

Désolé de ne pas avoir pu tester avant, je suis de retour que ce matin

Je notes le sujet résolu et je te remercies sincèrement pour ce fabuleux coup de main.

Avec mes meilleurs messages, je te souhaite un très bel été

Sincèrement

Serji