IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Voir le flux RSS

patricktoulon

ma collection de boites de dialogue perso

Note : 8 votes pour une moyenne de 1,00.
par , 28/09/2018 à 08h54 (579 Affichages)
[CENTER]
Contrairement a mon abitude de travailler avec des classes j'ai pris un chemin different sur ce theme
les fonctions qui vont suivre concernant des boites de dialogue perso n'utilisent pas de module classe
tout est crée dynamiquement (userform ,controls,code)
rien n'existe avant fonction ,rien n'existe apres que la fonction ai fait son job
tout se passe dans la fonction dans un module standard

[B]episode 1[/B]
[B]
Boite de dialogue pour changer l'imprimante par defaut de windows ([COLOR=#800000]ne change en rien les parametres d'excel[/COLOR])

[/B][/CENTER]
il peut nous arriver de devoir imprimer un ou une liste de fichiers externes sur une imprimante precise
pour cela il nous faut determiner cette imprimante par defaut
donc voici une petite boites de dialogue perso dans un userform qui peut vous permettre de le faire

[CODE=vba]Option Explicit
'**********************************************************************************************
' COLLECTION DE BOITES DE DIALOG PERSO *
' modele: dialog selection d'imprimante par defaut dans les parametres WINDOWS pas excel *
'Utile quand on veut imprimer un fichier externe a l'application sur imprimante particuliere *
' version 1.0 :-: Date:22/09/2018 *
' author: patricktoulon sur DVP.com ;alias [EMAIL="chamalin2@hotmail.com"]chamalin2@hotmail.com[/EMAIL] *
'**********************************************************************************************
Sub test()
Dim imprimante
imprimante = open_dialog_Windows_printer
MsgBox imprimante
End Sub
Function open_dialog_Windows_printer() As Variant
Dim ObJ As Object, J%, UsF
Dim colItems As Object, objItem As Object
Set UsF = ThisWorkbook.VBProject.VBComponents.Add(3)
With UsF
.Properties("Caption") = "Choisir une Imprimante Windows": .Properties("Width") = 250: .Properties("Height") = 120:
.Properties("Backcolor") = RGB(230, 230, 230)
Set ObJ = UsF.Designer.Controls.Add("Forms.ListBox.1")
With ObJ: .Left = 5: .Top = 5: .Width = UsF.Properties("Width") - 15: .Height = UsF.Properties("Height") - 40: .Name = "liste": .BackColor = vbWhite
.ColumnCount = 2
End With
Set ObJ = UsF.Designer.Controls.Add("Forms.CommandButton.1")
With ObJ: .Left = 250 - 70: .Top = 120 - 42: .Width = 60: .Height = 20: .Name = "annuler": .Caption = "annuler": .BackColor = RGB(220, 220, 250): End With
Set ObJ = UsF.Designer.Controls.Add("Forms.CommandButton.1")
With ObJ: .Left = 250 - 140: .Top = 120 - 42: .Width = 60: .Height = 20: .Name = "Choisir": .Caption = "Choisir": .BackColor = RGB(150, 250, 150): End With
With .CodeModule
J = .countoflines
.insertlines J + 1, ""
.insertlines J + 2, "public newprinter as variant"
.insertlines J + 3, "'"
.insertlines J + 4, "Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)"
.insertlines J + 5, "Cancel=true:newprinter=false: Me.Hide "
.insertlines J + 6, "End Sub" & vbCrLf & "'"
.insertlines J + 7, "Private Sub annuler_Click():newprinter=false:me.hide :end sub "
.insertlines J + 8, "Private Sub choisir_Click()"
.insertlines J + 10, "Dim imprim as object"
.insertlines J + 11, "If liste.value <> """" Then"
.insertlines J + 12, "Set imprim = CreateObject(""WScript.Network""): imprim.SetDefaultPrinter liste.value"
.insertlines J + 13, "newprinter = liste.Value: Me.Hide"
.insertlines J + 14, "Else"
.insertlines J + 15, "MsgBox ""vous devez en selectionner une !!"""
.insertlines J + 16, "End If"
.insertlines J + 17, "End Sub"
End With
End With
VBA.UserForms.Add (UsF.Name)
With UserForms(UserForms.Count - 1)
Set colItems = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * from Win32_Printer", , 48)
With .liste
For Each objItem In colItems
.AddItem objItem.Name: .List(.ListCount - 1, 1) = IIf(objItem.Default = True, "Par defaut", "----------")
Next
End With
.Show
open_dialog_Windows_printer = .newprinter
End With
ThisWorkbook.VBProject.VBComponents.Remove (UsF)
End Function


[/CODE]
[ATTACH=CONFIG]415617[/ATTACH]

petite precision importante
le project doit etre approuvé
[B]Sécurité des macros>Paramètres des macros> cocher la case "Accès approuvé au modèle d'objet du projet VBA".
[/B]merci pijaku pour le rappel[B];)
[/B]
Miniatures attachées Images attachées  

Envoyer le billet « ma collection de boites de dialogue perso » dans le blog Viadeo Envoyer le billet « ma collection de boites de dialogue perso » dans le blog Twitter Envoyer le billet « ma collection de boites de dialogue perso » dans le blog Google Envoyer le billet « ma collection de boites de dialogue perso » dans le blog Facebook Envoyer le billet « ma collection de boites de dialogue perso » dans le blog Digg Envoyer le billet « ma collection de boites de dialogue perso » dans le blog Delicious Envoyer le billet « ma collection de boites de dialogue perso » dans le blog MySpace Envoyer le billet « ma collection de boites de dialogue perso » dans le blog Yahoo

Mis à jour 10/11/2018 à 15h40 par LittleWhite (Coloration du code)

Catégories
Sans catégorie

Commentaires