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 (207 Affichages)

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

episode 1

Boite de dialogue pour changer l'imprimante par defaut de windows (ne change en rien les parametres d'excel)

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 : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
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 <a href="mailto:chamalin2@hotmail.com">chamalin2@hotmail.com</a>                              *
'**********************************************************************************************
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
Nom : demo.gif
Affichages : 77
Taille : 499,1 Ko

petite precision importante
le project doit etre approuvé
Sécurité des macros>Paramètres des macros> cocher la case "Accès approuvé au modèle d'objet du projet VBA".
merci pijaku pour le rappel

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