XL 2013 Changement port Ne pour imprimante sélectionner

jbgaillard · 14 Avril 2022

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

Bernard_XLD · 15 Avril 2022

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...

Hasco · 14 Avril 2022

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

Phil69970 · 14 Avril 2022

Bonjour @jbgaillard

Edit bonjour @Hasco

Juste en regardant vite fait ton code je pense qu’ici il y a un problème

Nom = "\\chuprnv3\i0983 sur Ne0' & aa & ':"

Si tu as :

jbgaillard à dit:
Ce Ne peut aller de Ne00 à Ne99

Alors Ne0 & aa ne peut pas fonctionner

jbgaillard à dit:
For aa = 0 To 99

puisqu'à 10 et plus tu auras Ne010..... Ne011.....

@Phil69970

Bernard_XLD · 14 Avril 2022

Bonjour le fil, le forum

Ou tout simplement laisser le choix de l'imprimante à l'utilisateur.

Cordialement, @+

VB:

Application.Dialogs(xlDialogPrinterSetup).Show

jbgaillard · 14 Avril 2022

Bernard_XLD à dit:
Bonjour le fil, le forum

Ou tout simplement laisser le choix de l'imprimante à l'utilisateur.

Cordialement, @+

VB:

Application.Dialogs(xlDialogPrinterSetup).Show

Merci pour ce retour

Mais comment je l'intègre dans mon vba

Désolé pour ces questions de béotiens

jbgaillard · 14 Avril 2022

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

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

Bernard_XLD · 14 Avril 2022

re,

jbgaillard à dit:
Merci pour ce retour

Mais comment je l'intègre dans mon vba

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, @+

jbgaillard · 14 Avril 2022

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, @+

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

Bernard_XLD · 14 Avril 2022

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

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

jbgaillard · 15 Avril 2022

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

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,

Bernard_XLD · 15 Avril 2022

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

Bernard_XLD · 15 Avril 2022

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

jbgaillard · 15 Avril 2022

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

MILLE mercis.

Cela fonctionne à la perfection.

Bien Cordialement

Bernard_XLD · 15 Avril 2022

Re,

jbgaillard à dit:
Cela fonctionne à la perfection.

N'oubliez pas, pour mettre le fil en résolu et faciliter les recherches d'autres personnes, de cocher la solution, la petite coche à droite du post contenant la solution.

Bonne journée
Bien cordialement, @+

Phil69970 · 15 Avril 2022

Bonjour à tous

@Bernard_XLD pour ma gouverne personnelle un simple "option compare text" n'aurait pas pu suffire ?

@Phil69970

XL 2013 Changement port Ne pour imprimante sélectionner

jbgaillard

XLDnaute Nouveau

Bernard_XLD

Hasco

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

Bernard_XLD

XLDnaute Barbatruc

jbgaillard

XLDnaute Nouveau

jbgaillard

XLDnaute Nouveau

Bernard_XLD

XLDnaute Barbatruc

jbgaillard

XLDnaute Nouveau

Bernard_XLD

XLDnaute Barbatruc

jbgaillard

XLDnaute Nouveau

Bernard_XLD

XLDnaute Barbatruc

Bernard_XLD

XLDnaute Barbatruc

jbgaillard

XLDnaute Nouveau

Bernard_XLD

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

Discussions similaires