XL 2013 Changement port Ne pour imprimante sélectionner

J

jbgaillard

XLDnaute Nouveau
Bonjour,

N'étant pas vraiment familier avec le langage VBA, j'en appelle à votre aide.
Je cherche à imprimer des étiquettes à partir d'un bouton avec une macro associée. (cellules A1 à B3 de l'onglet Etiquettes dans l'exemple)
j'ai donc créer un code VBA mais j'ai deux problèmes:
- l'imprimante à utiliser (\\chuprnv3\i0983) n'est pas celle paramétrée par défaut sur l'ordinateur (\\chuprnv3\i0810)
- ces imprimantes étant en réseau le Ne00 associée change en fonction des utilisateurs je pense donc je n'ai pas d'adresse fixe comme par exemple \\chuprnv3\i0983 sur Ne05:
Ce Ne peut aller de Ne00 à Ne99

Voici le code VBA :

Sub Pvt1G()
Set Feuille = ActiveSheet
For aa = 0 To 99
Nom = "\\chuprnv3\i0983 sur Ne0' & aa & ':"
On Error Resume Next
Application.ActivePrinter = Nom
If ActivePrinter = Nom Then Exit For
Next
Application.ActivePrinter = Nom
Sheets("Etiquettes").Range("A1:B3").PrintOut , , 2
'on remet l'imprimante par défaut
For aa = 0 To 99
Nom = "\\chuprnv3\i0810 sur Ne0' & aa & ':"
On Error Resume Next
Application.ActivePrinter = Nom
If ActivePrinter = Nom Then Exit For
Next
Feuille.Select

End Sub


Merci d'avance pour votre aide
 
Solution
Bernard_XLD
re,

au cas ou ce serait un problème de minuscules majuscules dans les noms d'imprimantes, le code modifié pour ignorer la casse et ne comparer que sur l'adresse.

Cordialement, @+
Code: 
Sub Pvt1G()
Dim Mem_Imprim, Imprimante_en_Cours, Imprimantes_Utilisateur, ObjWMIService, Test_Imprim As Boolean
Mem_Imprim = Application.ActivePrinter
Set ObjWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set Imprimantes_Utilisateur = ObjWMIService.ExecQuery("Select * from Win32_Printer")
For Each Imprimante_en_Cours In Imprimantes_Utilisateur
    If Left(LCase(Imprimante_en_Cours.Name), 16) = "\\chuprnv3\i0983" Then
        Test_Imprim = True
        On Error GoTo Gere_Erreurs...
Trier par date Trier par votes
Hasco

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour

Si ça va de Ne00 à Ne99 :

VB: 
Nom = "\\chuprnv3\i0983 sur Ne" & Format(aa,"00") & ":"

Attention aux " et aux '
Faites une recherche sur le forum qui regorge de ce genre de choses (mot clef: Ne00)

Cordialement
 
Vote positif 0 Vote négatif
Phil69970

Phil69970

XLDnaute Barbatruc
Vote positif 0 Vote négatif
J

jbgaillard

XLDnaute Nouveau
Hasco à dit:
Bonjour

Si ça va de Ne00 à Ne99 :

VB: 
Nom = "\\chuprnv3\i0983 sur Ne" & Format(aa,"00") & ":"

Attention aux " et aux '
Faites une recherche sur le forum qui regorge de ce genre de choses (mot clef: Ne00)

Cordialement
Cliquez pour agrandir...
Bonjour,

J'ai testé dans mon VBA, mais l'imprimante n'est pas sélectionnée correctement. L'impression se fait sur la dernière imprimante utilisée lors d'une impression "manuelle" dans Excel.

Merci d'avance pour votre retour
 
Vote positif 0 Vote négatif
J

jbgaillard

XLDnaute Nouveau
Bernard_XLD à dit:
re,


Comme cela.
VB: 
Sub Pvt1G()
Dim Mem_Imprim
Mem_Imprim = Application.ActivePrinter
Application.Dialogs(xlDialogPrinterSetup).Show
Sheets("Etiquettes").Range("A1:B3").PrintOut , , 2
Application.ActivePrinter = Mem_Imprim
End Sub

Cordialement, @+
Cliquez pour agrandir...
Parfait Merci

Cela fonctionne, je peux au moins choisir l'imprimante, dans l'attente de pvoir faire varier le Ne de l'imprimante par défaut
 
Vote positif 0 Vote négatif
Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
re,

jbgaillard à dit:
Cela fonctionne, je peux au moins choisir l'imprimante, dans l'attente de pvoir faire varier le Ne de l'imprimante par défaut
Cliquez pour agrandir...

Si vous y tenez tant que cela !

Cordialement, @+
VB: 
Option Explicit
Sub Pvt1G()
Dim Mem_Imprim, Imprimante_en_Cours, Imprimantes_Utilisateur, ObjWMIService, Test_Imprim As Boolean
Mem_Imprim = Application.ActivePrinter
Set ObjWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set Imprimantes_Utilisateur = ObjWMIService.ExecQuery("Select * from Win32_Printer")
For Each Imprimante_en_Cours In Imprimantes_Utilisateur
    If Left(Imprimante_en_Cours.Name, 23) = "\\chuprnv3\i0983 sur Ne" Then
        Test_Imprim = True
        On Error GoTo Gere_Erreurs
        Sheets("Etiquettes").Range("A1:B3").PrintOut Copies:=2, ActivePrinter:=Imprimante_en_Cours.Name
        On Error GoTo 0
        Exit For
    End If
Next Imprimante_en_Cours
If Test_Imprim Then
    MsgBox Prompt:="L'impression a été envoyée", Title:="Information", Buttons:=vbOKOnly + vbInformation
Else
    MsgBox Prompt:="L'imprimante \\chuprnv3\i0983 n'a pas été détectée", Title:="Information", Buttons:=vbOKOnly + vbInformation
End If
Application.ActivePrinter = Mem_Imprim
Exit Sub
Gere_Erreurs:
Application.ActivePrinter = Mem_Imprim
MsgBox Prompt:="Un problème a été détecté lors de l'impression." & vbLf & _
            "Erreur " & Err & " interceptée !" & vbLf & "Type : " & Error(Err), Title:="Information", Buttons:=vbOKOnly + vbCritical
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
J

jbgaillard

XLDnaute Nouveau
Bernard_XLD à dit:
re,



Si vous y tenez tant que cela !

Cordialement, @+
VB: 
Option Explicit
Sub Pvt1G()
Dim Mem_Imprim, Imprimante_en_Cours, Imprimantes_Utilisateur, ObjWMIService, Test_Imprim As Boolean
Mem_Imprim = Application.ActivePrinter
Set ObjWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set Imprimantes_Utilisateur = ObjWMIService.ExecQuery("Select * from Win32_Printer")
For Each Imprimante_en_Cours In Imprimantes_Utilisateur
    If Left(Imprimante_en_Cours.Name, 23) = "\\chuprnv3\i0983 sur Ne" Then
        Test_Imprim = True
        On Error GoTo Gere_Erreurs
        Sheets("Etiquettes").Range("A1:B3").PrintOut Copies:=2, ActivePrinter:=Imprimante_en_Cours.Name
        On Error GoTo 0
        Exit For
    End If
Next Imprimante_en_Cours
If Test_Imprim Then
    MsgBox Prompt:="L'impression a été envoyée", Title:="Information", Buttons:=vbOKOnly + vbInformation
Else
    MsgBox Prompt:="L'imprimante \\chuprnv3\i0983 n'a pas été détectée", Title:="Information", Buttons:=vbOKOnly + vbInformation
End If
Application.ActivePrinter = Mem_Imprim
Exit Sub
Gere_Erreurs:
Application.ActivePrinter = Mem_Imprim
MsgBox Prompt:="Un problème a été détecté lors de l'impression." & vbLf & _
            "Erreur " & Err & " interceptée !" & vbLf & "Type : " & Error(Err), Title:="Information", Buttons:=vbOKOnly + vbCritical
End Sub
Cliquez pour agrandir...
Merci infiniment pour tout ce travail.

Malheureusement,cela ne fonctionne pas j'ai toujours le message : "L'imprimante \\chuprnv3\i0983 n'a pas été détectée"

Bien cordialement,
 
Vote positif 0 Vote négatif
Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Bonjour

Malheureusement, je ne peux faire qu'avec le nom d'imprimante que vous avez donné, la moindre erreur sur le nom réellement utilisé et cela ne fonctionnera pas..
Ce petit programme vous permettra de lister vos imprimantes et de vérifier les noms réellement utilisés sur les imprimantes installées.
Faites une copie d'écran du message avec alt imprimécran et postez la avec Ctrl V dans le post.

Cordialement, @+
VB: 
Sub Test_Imprimantes()
Dim Imprimante_en_Cours, Imprimantes_Utilisateur, ObjWMIService, Retour_Imprimantes$
Set ObjWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set Imprimantes_Utilisateur = ObjWMIService.ExecQuery("Select * from Win32_Printer")
For Each Imprimante_en_Cours In Imprimantes_Utilisateur
    Retour_Imprimantes = IIf(Retour_Imprimantes = "", Imprimante_en_Cours.Name, Retour_Imprimantes & vbLf & Imprimante_en_Cours.Name)
Next Imprimante_en_Cours
MsgBox Retour_Imprimantes, vbOKOnly + vbInformation
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
re,

au cas ou ce serait un problème de minuscules majuscules dans les noms d'imprimantes, le code modifié pour ignorer la casse et ne comparer que sur l'adresse.

Cordialement, @+
Code: 
Sub Pvt1G()
Dim Mem_Imprim, Imprimante_en_Cours, Imprimantes_Utilisateur, ObjWMIService, Test_Imprim As Boolean
Mem_Imprim = Application.ActivePrinter
Set ObjWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set Imprimantes_Utilisateur = ObjWMIService.ExecQuery("Select * from Win32_Printer")
For Each Imprimante_en_Cours In Imprimantes_Utilisateur
    If Left(LCase(Imprimante_en_Cours.Name), 16) = "\\chuprnv3\i0983" Then
        Test_Imprim = True
        On Error GoTo Gere_Erreurs
        Sheets("Etiquettes").Range("A1:B3").PrintOut Copies:=2, ActivePrinter:=Imprimante_en_Cours.Name
        On Error GoTo 0
        Exit For
    End If
Next Imprimante_en_Cours
If Test_Imprim Then
    MsgBox Prompt:="L'impression a été envoyée", Title:="Information", Buttons:=vbOKOnly + vbInformation
Else
    MsgBox Prompt:="L'imprimante \\chuprnv3\i0983 n'a pas été détectée", Title:="Information", Buttons:=vbOKOnly + vbInformation
End If
Application.ActivePrinter = Mem_Imprim
Exit Sub
Gere_Erreurs:
Application.ActivePrinter = Mem_Imprim
MsgBox Prompt:="Un problème a été détecté lors de l'impression." & vbLf & _
            "Erreur " & Err & " interceptée !" & vbLf & "Type : " & Error(Err), Title:="Information", Buttons:=vbOKOnly + vbCritical
End Sub
 
Vote positif 0 Vote négatif
Solution
J

jbgaillard

XLDnaute Nouveau
Bernard_XLD à dit:
re,

au cas ou ce serait un problème de minuscules majuscules dans les noms d'imprimantes, le code modifié pour ignorer la casse et ne comparer que sur l'adresse.

Cordialement, @+
Code: 
Sub Pvt1G()
Dim Mem_Imprim, Imprimante_en_Cours, Imprimantes_Utilisateur, ObjWMIService, Test_Imprim As Boolean
Mem_Imprim = Application.ActivePrinter
Set ObjWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set Imprimantes_Utilisateur = ObjWMIService.ExecQuery("Select * from Win32_Printer")
For Each Imprimante_en_Cours In Imprimantes_Utilisateur
    If Left(LCase(Imprimante_en_Cours.Name), 16) = "\\chuprnv3\i0983" Then
        Test_Imprim = True
        On Error GoTo Gere_Erreurs
        Sheets("Etiquettes").Range("A1:B3").PrintOut Copies:=2, ActivePrinter:=Imprimante_en_Cours.Name
        On Error GoTo 0
        Exit For
    End If
Next Imprimante_en_Cours
If Test_Imprim Then
    MsgBox Prompt:="L'impression a été envoyée", Title:="Information", Buttons:=vbOKOnly + vbInformation
Else
    MsgBox Prompt:="L'imprimante \\chuprnv3\i0983 n'a pas été détectée", Title:="Information", Buttons:=vbOKOnly + vbInformation
End If
Application.ActivePrinter = Mem_Imprim
Exit Sub
Gere_Erreurs:
Application.ActivePrinter = Mem_Imprim
MsgBox Prompt:="Un problème a été détecté lors de l'impression." & vbLf & _
            "Erreur " & Err & " interceptée !" & vbLf & "Type : " & Error(Err), Title:="Information", Buttons:=vbOKOnly + vbCritical
End Sub
Cliquez pour agrandir...
MILLE mercis.

Cela fonctionne à la perfection.

Bien Cordialement
 
Vote positif 0 Vote négatif

Discussions similaires

Y
  • Résolu(e)
XL 2021 Macro pour imprimer un document
Réponses
2
Affichages
573
Yoan_VBA
Y
L
  • Résolu(e)
XL 2016 RESOLU Imprimer un fichier excel sur trois imprimantes réseau
Réponses
4
Affichages
1 K
Linalor
L
B
  • Question
XL 2021 Transfert tableau structuré EXCEL à un endroit précis de WORD
Réponses
8
Affichages
292
job75
job75
Usine à gaz
  • Résolu(e)
Microsoft 365 lister des fichiers
2
Réponses
19
Affichages
2 K
Usine à gaz
Usine à gaz
E
  • Question
Microsoft 365 VBA Calendrier, rien ne se passe.
Réponses
12
Affichages
596
fanch55
fanch55
Lu76Fer
  • Question
XL 2016 Notation Simplifiée pour définir un tableau arborescent
Réponses
9
Affichages
552
Lu76Fer
Lu76Fer
M
  • Question
XL 2019 Sélectionner une feuille avec nom dans une variable VBA
Réponses
4
Affichages
1 K
ManOfCatz
M
S
  • Résolu(e)
XL 2016 modification de code vba
Réponses
7
Affichages
750
cp4
cp4
oguruma
Classe VBA pour gérer les paramètres d'une application
Réponses
3
Affichages
655
oguruma
oguruma
K
  • Résolu(e)
XL 2016 Ne garder que les chiffres dans la colonne A et remplacer les h et '
2
Réponses
16
Affichages
975
Phil69970
Phil69970

Membres actuellement en ligne

17 membres et 395 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 025
Messages
2 084 736
Membres
102 648
dernier inscrit
radhwane taibi