[VBA] Associer "onclick" à un label crée par macro

Bonsoir,
Faut pas qui en ait trop...

Crée un module de classe et avec la fenêtre des propriétés

nommes le ClassLabel

''''''dans ClassLabel

Public WithEvents MyLbl As MSForms.Label
Private Sub MyLbl_Click()
Workbooks.Open MyLbl.Caption
End Sub


''''''dans Userform1

Private MeslBl() As New ClassLabel
Private Sub UserForm_Initialize()
Dim f As String, I As Byte
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, Message, 0, "c:")

chemin = objFolder.parentfolder.ParseName(objFolder.Title).Path

ChDir chemin

f = Dir("*.xls")
Do While Len(f) > 0
I = I + 1
Set Obj = Me.Controls.Add("forms.label.1")
Obj.Name = "Plabel" & I
Obj.Caption = chemin & "" & f
f = Dir
Loop
Call ClasseLb
End Sub

Private Sub ClasseLb()
Dim elt As Control, I&
For Each elt In Me.Controls
If TypeName(elt) = "Label" Then
ReDim Preserve MeslBl(0 To I)
Set MeslBl(I).MyLbl = elt
I = I + 1
End If
Next elt
End Sub
Private Sub UserForm_Terminate()
Dim I&
For I = 0& To UBound(MeslBl)
Set MeslBl(I) = Nothing
Next I
End Sub


'lSteph

Bonjour à tous ;)

Je remplis un userform avec des labels qui correspondent à des fichiers
trouvés dans un repertoire donné.

Grossierement, je fait ceci avec :

Application.fileSearch
For i = 1 to .foundfiles.count
Set Obj = UserForm16.Controls.Add("forms.label.1")
Obj.Name = "Plabel" & I
Obj.Caption = Chemindufichier

Je voudrais arriver à "déclarer" l'evenement du click sur un de ces labels
afin d'ouvrir le fichier correspondant à sa création.

Existe-t-il un moyen "généraliste" de faire ceci ?

Ceci ne marche pas, mais ça pourrait vous aider à cerner ce que je veux
faire :

Private Sub UserForm_Activate()
For Each Objet In UserForm16.Controls
if typeof Objet is MSForms.label then
Objet.Onclick.Action = "Commande d'ouverture du fichier"
end if
next
end sub

Voilà ça peut paraitre tordu^^ mais j'espere qu'une âme charitable saurait
m'aiguiller :)

Merci beaucoup !

Bonsoir,

J'ai testé un peu vite sur un rep avec juste un fichier
...au cas où pour le confort:
mets le scrollheight du userform à 1000 et frmscrollbarsvertical
garde le code du userform comme j'ai donné mais
rectifie le initialize ainsi:

Private Sub UserForm_Initialize()
Dim f As String, I As Byte, oBj As Control
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, Message, 0, "c:")

chemin = objFolder.parentfolder.ParseName(objFolder.Title).Path

ChDir chemin

f = Dir("*.xls")
Do While Len(f) > 0
I = I + 1
Set oBj = Me.Controls.Add("forms.label.1")
oBj.Name = "Plabel" & I
oBj.Caption = chemin & "" & f
oBj.Top = I * 15
oBj.Left = 8
oBj.Width = Me.Width - 20
Set oBj = Nothing
f = Dir
Loop
Call ClasseLb
End Sub

'lSteph

Bonjour à tous ;)

Je remplis un userform avec des labels qui correspondent à des fichiers
trouvés dans un repertoire donné.

Grossierement, je fait ceci avec :

Application.fileSearch
For i = 1 to .foundfiles.count
Set Obj = UserForm16.Controls.Add("forms.label.1")
Obj.Name = "Plabel" & I
Obj.Caption = Chemindufichier

Je voudrais arriver à "déclarer" l'evenement du click sur un de ces labels
afin d'ouvrir le fichier correspondant à sa création.

Existe-t-il un moyen "généraliste" de faire ceci ?

Ceci ne marche pas, mais ça pourrait vous aider à cerner ce que je veux
faire :

Private Sub UserForm_Activate()
For Each Objet In UserForm16.Controls
if typeof Objet is MSForms.label then
Objet.Onclick.Action = "Commande d'ouverture du fichier"
end if
next
end sub

Voilà ça peut paraitre tordu^^ mais j'espere qu'une âme charitable saurait
m'aiguiller :)

Merci beaucoup !

;o)
Bon à force on va y arriver,exemple ici:

http://cjoint.com/?jywNCMUMzQ

j'avais aussi oublié de gèrer l'annulation et
du coup je recompose le truc , on garde le principe du module de classe
mais on suppose qu'on lance depuis feuil1 par dblclic et qu'un module
standard prévoit le choix du chemin avant d'afficher le userform

'''''Code Feuil1
Private Sub Worksheet_BeforeDoubleClick(ByVal _
Target As Range, Cancel As Boolean)
Call affiche
cancel=true
chemin = ""
End Sub

'''''Module1
Public chemin As String
Sub affiche()
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, Message, 0, "c:")

On Error Resume Next
chemin = objFolder.parentfolder.ParseName(objFolder.Title).Path
On Error GoTo 0

If Len(chemin) = 0 Then Exit Sub

UserForm1.Show
End Sub

'''''ClassLabel
Public WithEvents MyLbl As MSForms.Label
Private Sub MyLbl_Click()
Workbooks.Open MyLbl.Caption
End Sub

'''''Userform1
Private Sub UserForm_Initialize()
Dim f As String, I As Byte, oBj As Control

ChDir chemin

f = Dir("*.xls")
Do While Len(f) > 0
I = I + 1
Set oBj = Me.Controls.Add("forms.label.1")
oBj.Name = "Plabel" & I
oBj.Caption = chemin & "" & f
oBj.Top = I * 15
oBj.Left = 8
oBj.Width = Me.Width - 20
Set oBj = Nothing
f = Dir
Loop
Call ClasseLb
End Sub

Private Sub ClasseLb()
Dim elt As Control, I&
For Each elt In Me.Controls
If TypeName(elt) = "Label" Then
ReDim Preserve MeslBl(0 To I)
Set MeslBl(I).MyLbl = elt
I = I + 1
End If
Next elt
End Sub
Private Sub UserForm_Terminate()
Dim I&
On Error Resume Next
For I = 0& To UBound(MeslBl)
Set MeslBl(I) = Nothing
Next I
On Error GoTo 0
End Sub
''''''''''''''''''''''''''''''''

'lSteph

Bonjour à tous ;)

Je remplis un userform avec des labels qui correspondent à des fichiers
trouvés dans un repertoire donné.

Grossierement, je fait ceci avec :

Application.fileSearch
For i = 1 to .foundfiles.count
Set Obj = UserForm16.Controls.Add("forms.label.1")
Obj.Name = "Plabel" & I
Obj.Caption = Chemindufichier

Je voudrais arriver à "déclarer" l'evenement du click sur un de ces labels
afin d'ouvrir le fichier correspondant à sa création.

Existe-t-il un moyen "généraliste" de faire ceci ?

Ceci ne marche pas, mais ça pourrait vous aider à cerner ce que je veux
faire :

Private Sub UserForm_Activate()
For Each Objet In UserForm16.Controls
if typeof Objet is MSForms.label then
Objet.Onclick.Action = "Commande d'ouverture du fichier"
end if
next
end sub

Voilà ça peut paraitre tordu^^ mais j'espere qu'une âme charitable saurait
m'aiguiller :)

Merci beaucoup !

...reoupss (j'aurais pas dû sourire de Philippe l'autre jour)
...sans oublier quand on copie le code la ligne tout en haut de celui
du userform:

Private MeslBl() As New ClassLabel

On 24 sep, 22:51, LSteph <lecocost...@frite.fr> wrote:

;o)
Bon à force on va y arriver,exemple ici:

http://cjoint.com/?jywNCMUMzQ

j'avais aussi oublié de gèrer l'annulation et
du coup je recompose le truc , on garde le principe du module de classe
mais on suppose qu'on lance depuis feuil1 par dblclic et qu'un module
standard prévoit le choix du chemin avant d'afficher le userform

'''''Code Feuil1
Private Sub Worksheet_BeforeDoubleClick(ByVal _
Target As Range, Cancel As Boolean)
Call affiche
cancel=true
chemin = ""
End Sub

'''''Module1
Public chemin As String
Sub affiche()
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, Message, 0, "c:")

On Error Resume Next
chemin = objFolder.parentfolder.ParseName(objFolder.Title).Path
On Error GoTo 0

If Len(chemin) = 0 Then Exit Sub

UserForm1.Show
End Sub

'''''ClassLabel
Public WithEvents MyLbl As MSForms.Label
Private Sub MyLbl_Click()
Workbooks.Open MyLbl.Caption
End Sub

'''''Userform1
Private Sub UserForm_Initialize()
Dim f As String, I As Byte, oBj As Control

ChDir chemin

f = Dir("*.xls")
Do While Len(f) > 0
I = I + 1
Set oBj = Me.Controls.Add("forms.label.1")
oBj.Name = "Plabel" & I
oBj.Caption = chemin & "" & f
oBj.Top = I * 15
oBj.Left = 8
oBj.Width = Me.Width - 20
Set oBj = Nothing
f = Dir
Loop
Call ClasseLb
End Sub

Private Sub ClasseLb()
Dim elt As Control, I&
For Each elt In Me.Controls
If TypeName(elt) = "Label" Then
ReDim Preserve MeslBl(0 To I)
Set MeslBl(I).MyLbl = elt
I = I + 1
End If
Next elt
End Sub
Private Sub UserForm_Terminate()
Dim I&
On Error Resume Next
For I = 0& To UBound(MeslBl)
Set MeslBl(I) = Nothing
Next I
On Error GoTo 0
End Sub
''''''''''''''''''''''''''''''''

'lSteph

Bonjour à tous ;)

Je remplis un userform avec des labels qui correspondent à des fichie rs
trouvés dans un repertoire donné.

Grossierement, je fait ceci avec :

Application.fileSearch
For i = 1 to .foundfiles.count
Set Obj = UserForm16.Controls.Add("forms.label.1")
Obj.Name = "Plabel" & I
Obj.Caption = Chemindufichier

Je voudrais arriver à "déclarer" l'evenement du click sur un de ces labels
afin d'ouvrir le fichier correspondant à sa création.

Existe-t-il un moyen "généraliste" de faire ceci ?

Ceci ne marche pas, mais ça pourrait vous aider à cerner ce que je veux
faire :

Private Sub UserForm_Activate()
For Each Objet In UserForm16.Controls
if typeof Objet is MSForms.label then
Objet.Onclick.Action = "Commande d'ouverture du fichier"
end if
next
end sub

Voilà ça peut paraitre tordu^^ mais j'espere qu'une âme charitabl e saurait
m'aiguiller :)

Merci beaucoup !

Merci beaucoup LSteph de t'être penché la-dessus, j'y regarde de plus près
des que j'ai un peu de temps (déménagement de bureau surprise ce matin ;o).

Cordialement,

Bonjour Michael,

oui, "mauvaise surprise" si tu dois te pencher, n'attrappe pas un
lumbago,....avec les cartons!
:-)

à l'occasion tu nous dira si cela convient.

Le principe du module de classe ici est de pouvoir assigner l'évennement
à l'ensemble des labels sur lequel on a bouclé.

@+

--
lSteph

Merci beaucoup LSteph de t'être penché la-dessus, j'y regarde de plus près
des que j'ai un peu de temps (déménagement de bureau surprise ce matin ;o).

Cordialement,

Bonjour,

Adapté à mon fichier, ça marche très bien :)

Merci encore !


"LSteph" <lecocosteph@frite.fr> a écrit dans le message de news:
eb9z0MAAIHA.5184@TK2MSFTNGP02.phx.gbl...

Bonjour Michael,

oui, "mauvaise surprise" si tu dois te pencher, n'attrappe pas un
lumbago,....avec les cartons!
:-)

à l'occasion tu nous dira si cela convient.

Le principe du module de classe ici est de pouvoir assigner l'évennement à
l'ensemble des labels sur lequel on a bouclé.

@+

--
lSteph

Merci beaucoup LSteph de t'être penché la-dessus, j'y regarde de plus
près des que j'ai un peu de temps (déménagement de bureau surprise ce
matin ;o).

Cordialement,