Petits soucis avec typeof ou typename

**patricktoulon** · 04/02/2019, 13h40

Bonjour a tous
je souhaite récupérer l'emplacement d'un control en terme de top et left par rapport a son userform qui n'est pas forcement le parent direct
en effet il peut etre dans une frame ou multipage ou dans l'un qui est dans l'autre
bref dans la boucle je récupere le left et top de chaque parent successif et cela doit remonter jusqu'au userform

manque de pot
avec typeof il nous faut coder le nom en dur du userform
c'est a dire par exemple avec un userform s'apellant "toto"
typeof place is toto

pour typename c'est pareil il nous faut le nom du userform et pas le nom de type d'object
je suis bien ennuyé a cause de ca

un exemple dans un userform avec un textbox dans une frame qui elle meme est dans une autre frame qui elle meme est dans un multipage

y aurait il un moyen de teste si place dans la boucle est un userform sans en connaitre le nom

en gros remplacer "toto" par UserForm dans le code

Code :

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
Private Sub UserForm_Activate()
    Dim place As Object, texte
    Set place = TextBox1
    X = place.Left + place.Width + ecL: Y = place.Top + ect
    texte = texte & place.Name & " top = " & place.Top & "  left = " & place.Left & vbCrLf
    Do
        Set place = place.Parent
        Select Case True
        Case TypeOf place Is MultiPage: texte = texte & place.Name & " top = " & place.Top & "  left = " & place.Left & vbCrLf
        Case TypeOf place Is Frame: texte = texte & place.Name & " top = " & place.Top & "  left = " & place.Left & vbCrLf
 
 
        Case TypeOf place Is toto: texte = texte & place.Name & " top = " & place.Top & "  left = " & place.Left & vbCrLf:: Exit Do
 
        'Case InStr(TypeName(place), "toto") > 0: texte = texte & place.Name & " top = " & place.Top & "  left = " & place.Left & vbCrLf:: Exit Do
 
        End Select
 
    Loop
    Set place = Nothing
MsgBox texte
End Sub

**Trystan441** · 04/02/2019, 14h06

Bonjour Patrick,

Je m'attaque certainement à plus technique que je ne le suis mais je tente quand même !

Tu ne peux pas déclarer une variable Userform ? Ceci afin de pouvoir y faire référence, peu importe le nom ?

**patricktoulon** · 04/02/2019, 14h16

Bonjour tristan
et non dans la sub final place sera un textbox et cette sub final ira dans x userform
le textbox sera un control d'un autre userform
je ne peut pas modifier le code a chaque fois que je change de userform

regarde l'erreur que ca genere sur le case "is userform"

Code :

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
Public place As Object
Private Sub UserForm_Activate()
    Dim texte$
    Set place = Me.TextBox1 'provisoirement pour les tests on prend le textbox de ce userform
 
    texte = texte & place.Name & " top = " & place.Top & "  left = " & place.Left & vbCrLf
    Do
        Set place = place.Parent
         Select Case True
        Case TypeOf place Is MultiPage: texte = texte & place.Name & " top = " & place.Top & "  left = " & place.Left & vbCrLf
        Case TypeOf place Is Frame: texte = texte & place.Name & " top = " & place.Top & "  left = " & place.Left & vbCrLf
        'Case TypeOf place Is toto: texte = texte & place.Name & " top = " & place.Top & "  left = " & place.Left & vbCrLf:: Exit Do
 
        'Case InStr(TypeName(place), "toto") > 0: texte = texte & place.Name & " top = " & place.Top & "  left = " & place.Left & vbCrLf:: Exit Do
 
        ' ici "is UserForm" match mais bizarrement place ne gere pas la propertie name, left et top
        Case TypeOf place Is UserForm:  texte = texte & place.Name & " top = " & place.Object.Top & "  left = " & place.Object.Left & vbCrLf:: Exit Do
        End Select
 
    Loop
    Set place = Nothing
MsgBox texte
End Sub

ca rends fou ca !!

**Theze** · 04/02/2019, 14h17

Bonjour Patrick,

Une piste pour remonter depuis le TextBox jusqu'à la Form :

Code :

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
 
Private Sub UserForm_Click()
 
    Dim Tbl() As Object
    Dim Fils As Object
    Dim Chaine As String
    Dim Total As Single
    Dim I As Integer
 
    Set Fils = TextBox1
 
    I = I + 1: ReDim Preserve Tbl(1 To I)
    Set Tbl(I) = Fils
 
    Do
 
        I = I + 1: ReDim Preserve Tbl(1 To I)
        Set Tbl(I) = Tbl(I - 1).Parent
 
    Loop Until TypeName(Tbl(I)) = Me.Name
 
    For I = 1 To UBound(Tbl) - 1 ' -1 pour ne pas prendre en compte la Form !
 
        'les pages d'un multipages n'ont pas de propriété Left et Top
        If TypeName(Tbl(I)) <> "Page" Then
 
            Chaine = Chaine & Tbl(I).Name & " Top : " & Tbl(I).Top & "  Left : " & Tbl(I).Left & vbCrLf
 
        End If
 
    Next I
 
    MsgBox Chaine
 
End Sub

**patricktoulon** · 04/02/2019, 14h39

re
Bonjour theze
et oui ca je sais sauf que :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Loop Until TypeName(Tbl(I)) = Me.Name

car le nom est sensé etre inconnu car textboxX est envoyé d'un autre userform
en gros ca marche comme ca
dans le userform1 avec mon textbox1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
With toto
.place = TextBox1
.Show
End With
end if 
End Sub

et maintenant dans le userform "toto"

Code :

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
[Public place As Object
Private Sub UserForm_Activate()
    Dim texte$
    'Set place = Me.TextBox1 'provisoirement pour les tests on prend le textbox de ce userform
 
    texte = texte & place.Name & " top = " & place.Top & "  left = " & place.Left & vbCrLf
    Do
        Set place = place.Parent
         Select Case True
        Case TypeOf place Is MultiPage: texte = texte & place.Name & " top = " & place.Top & "  left = " & place.Left & vbCrLf
        Case TypeOf place Is Frame: texte = texte & place.Name & " top = " & place.Top & "  left = " & place.Left & vbCrLf
        Case TypeOf place Is TabStrip: texte = texte & place.Name & " top = " & place.Top & "  left = " & place.Left & vbCrLf
 
 
 
        'Case TypeOf place Is toto: texte = texte & place.Name & " top = " & place.Top & "  left = " & place.Left & vbCrLf:: Exit Do
 
        'Case InStr(TypeName(place), "toto") > 0: texte = texte & place.Name & " top = " & place.Top & "  left = " & place.Left & vbCrLf:: Exit Do
 
        ' ici "is UserForm" match mais bizarrement place ne gere pas la propertie name, left et top
        'Case TypeOf place Is UserForm:  texte = texte & place.Name & " top = " & place.Object.Top & "  left = " & place.Object.Left & vbCrLf:: Exit Do
        End Select
 
    Loop
    Set place = Nothing
MsgBox texte
End Sub

il faut absolument que je cerne le type userform (son nom on s'en fout) pour récupérer son left et top
je vais peut etre etre obligé de mettre un 2d variable public en place dans "toto" et injecter le userform aussi

**unparia** · 04/02/2019, 15h03

Bonjour
Je ne suis pas certain d'avoir bien cerné le but final de la démarche.
S'il s'agit de savoir si le parent d'un contrôle objet_en_cause est ou non un userform et que ce userform est (indispensable) chargé (et donc dans la collection workbooks) -->>

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For Each f In UserForms
  If objet_en_cause.Parent.Name = f.Name Then MsgBox "le parent final est un userform"
Next

où objet_en_cause a bien évidemment d'abord été déterminé (de parent en parent précédents)

**Theze** · 04/02/2019, 15h04

La méthode un peu "bourin" avec le gestionnaire d'erreur :

Code :

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
 
Private Sub UserForm_Click()
 
    Dim Tbl() As Object
    Dim Fils As Object
    Dim Chaine As String
    Dim I As Integer
 
    Set Fils = TextBox1
 
    I = I + 1: ReDim Preserve Tbl(1 To I)
    Set Tbl(I) = Fils
 
    Do
 
        I = I + 1: ReDim Preserve Tbl(1 To I)
        Set Tbl(I) = Tbl(I - 1).Parent
        On Error Resume Next
        Chaine = ThisWorkbook.VBProject.VBComponents(Tbl(I).Name).CodeModule.Name
 
    Loop Until Err.Number = 0
 
    MsgBox "Le nom de l'UserForm est '" & Chaine & "' !"
 
End Sub

**zenpbb** · 04/02/2019, 15h52

Bonjour Patrick
Je ne vois pas pourquoi tu mets Object ici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Case TypeOf place Is UserForm:  texte = texte & place.Name & " top = " & place.Object.Top & "  left = " & place.Object.Left & vbCrLf

ça marche pas si tu mets place.Top et place.Left ?

**patricktoulon** · 04/02/2019, 16h33

re
bonjour

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ça marche pas si tu mets place.Top et place.Left ?

ben ca marche pas non et sans non plus

les problemes
si je me sert de typeof avec des controls le typeof match mais si j'ai nomé par exemple un control tototiti dans le case typeof la variable place ne gere plus les properties name,left,top

si je me sert de typename(place) dans le case userform ca match mais la variable object place ne gere plus les properties .left et .top

conclusion
j'ai opté pour ajouter une variable public "form dans le userform qui est appellé ,ca m'ennuyais mais bon a defaut hein

donc dans le userform1 ou il y a tout les textboxs qui vont appeller le 2d userform que j'ai nommé "cal"
les textbox sont pas forcement enfant directs du userform il se peut qu'il soit enfant d'une frame,d'un multipage voir meme des deux

Code :

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
Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
With cal
Set .place = TextBox1: Set .form = UserForm1
.Show
End With
End If
End Sub
Private Sub TextBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
With cal
Set .place = TextBox2: Set .form = UserForm1
.Show
End With
End If
End Sub
Private Sub TextBox3_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
With cal
Set .place = TextBox3: Set .form = UserForm1
.Show
End With
End If
End Sub
Private Sub TextBox4_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
With cal
Set .place = TextBox4: Set .form = UserForm1
.Show
End With
End If
End Sub
Private Sub TextBox5_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
With cal
Set .place = TextBox5: Set .form = UserForm1
.Show
End With
End If
End Sub

maintenant le userform "cal"
j'ai donc bien mes positions textbox PAR RAPORT A L'ECRAN!!!!
j'ai ajouté une contrainte que si le userform "cal" sort du chant de l'userform1 un redessage par raport a son perimetre
autrement dit le userform"cal" ne peut etre ailleurs que dans le userform1 (visuelement bien sur)

Code :

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
Public place As Object
Public form As Object
Private Sub UserForm_Activate()
    Dim texte$
    Dim X#, Y#, EcL#, EcT#, LW#, TH#
    EcL = Me.Width - Me.InsideWidth    'epaisseur cadre
    EcT = Me.Height - Me.InsideHeight    ' hauteur caption
    X = form.Left + place.Left + (EcL * 2)
    Y = form.Top + place.Top + EcT + EcL
    TH = form.Top + form.Height
    LW = form.Left + form.Width
    Do
        Set place = place.Parent
        Select Case True
            'Case TypeOf place Is MultiPage: x = x + place.Left + ecT: y = y + place.Top + (ecT * 3)
        Case TypeName(place) = "Page": Set place = place.Parent: Y = Y + place.Top + EcT - EcL: X = X + place.Left
            'Case TypeOf place Is Frame: Y = Y + place.Top: X = X + place.Left: Y = Y + EcL: X = X + (EcL / 2)
        Case TypeName(place) = "Frame": Y = Y + place.Top: X = X + place.Left: Y = Y + EcL: X = X + (EcL / 2)
        Case TypeOf place Is UserForm: Exit Do
        End Select
    Loop
    Y = IIf(Y + Me.Height > TH, TH - Me.Height, Y)
    X = IIf(X + Me.Width > LW, LW - Me.Width, X)
    Me.Left = X: Me.Top = Y
    Set place = Nothing
End Sub

demonstration de la finalité
Nom : demo2.gif
Affichages : 569
Taille : 379,1 Ko

si vous avez mieux dites moi je veux bien

**patricktoulon** · 04/02/2019, 17h58

Envoyé par unparia

Bonjour
Je ne suis pas certain d'avoir bien cerné le but final de la démarche.
S'il s'agit de savoir si le parent d'un contrôle objet_en_cause est ou non un userform et que ce userform est (indispensable) chargé (et donc dans la collection workbooks) -->>

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For Each f In UserForms
  If objet_en_cause.Parent.Name = f.Name Then MsgBox "le parent final est un userform"
Next

où objet_en_cause a bien évidemment d'abord été déterminé (de parent en parent précédents)

unparia ton idée n'est pas mauvaise ca m'ennuie de checker le place.aprent dans une sous boucle mais ca devrait fonctionner

**patricktoulon** · 04/02/2019, 20h17

re en fait j'ai trouvé la raison
la boucle do/loop faisait 1 tour de trop soit passait apres le userform

je n'ai donc pas besoins de la 2d variable tout est OK

dans le userform qui lance le 2d userform par les textboxs

Code :

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
Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 2 Then
        With cal
            Set .place = TextBox1
            .Show
        End With
    End If
End Sub
Private Sub TextBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 2 Then
        With cal
            Set .place = TextBox2
            .Show
        End With
    End If
End Sub

et dans le userform qui est lancé

Code :

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
 
 
Public place As Object
Private Sub UserForm_Activate()
    Dim texte$, form As Object
    If Not place Is Nothing Then
        Dim X#, Y#, EcL#, EcT#, LW#, TH#
        EcL = Me.Width - Me.InsideWidth: EcT = Me.Height - Me.InsideHeight    ' hauteur caption
        X = place.Left: Y = place.Top + place.Height + EcT + (EcL / 2)
        Do
            Set place = place.Parent
            Select Case True
            Case TypeName(place) = "Page": Set place = place.Parent: Y = Y + place.Top + EcT - EcL: X = X + place.Left
            Case TypeName(place) = "Frame": Y = Y + place.Top: X = X + place.Left: Y = Y + EcL + 1: X = X + (EcL / 2) + 1
            Case TypeOf place Is UserForm: X = X + place.Left + (EcL * 2): Y = Y + place.Top:     'MsgBox place.Left
                TH = place.Top + place.Height: LW = place.Left + place.Width
                Exit Do
            End Select
        Loop
        Y = IIf(Y + Me.Height > TH, TH - Me.Height, Y): X = IIf(X + Me.Width > LW, LW - Me.Width, X)
        Me.Left = X: Me.Top = Y
        Set place = Nothing: Set form = Nothing
    End If
End Sub

voila tout est OK

mon userform s'affiche bien endessous du textbox du premier userform qui été cliqué avec rectification sur les bords si il sort du périmetre du userform 1

Petits soucis avec typeof ou typename [Toutes versions]

Macros et VBA Excel

Discussions similaires

Partager

Partager