Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon application
doit rouler chez différents clients, le nombre de barres de couleurs peut
varier. Je dois donc créer ces images par programmation. Je sais que cela
est possible mais comment accéder à leurs événements MouseDown, MouseMove et
MouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler le
longueur des barres avec la souris. Tout celà doit se faire dans un UserForm
car les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon application
doit rouler chez différents clients, le nombre de barres de couleurs peut
varier. Je dois donc créer ces images par programmation. Je sais que cela
est possible mais comment accéder à leurs événements MouseDown, MouseMove et
MouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler le
longueur des barres avec la souris. Tout celà doit se faire dans un UserForm
car les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon application
doit rouler chez différents clients, le nombre de barres de couleurs peut
varier. Je dois donc créer ces images par programmation. Je sais que cela
est possible mais comment accéder à leurs événements MouseDown, MouseMove et
MouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler le
longueur des barres avec la souris. Tout celà doit se faire dans un UserForm
car les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon application
doit rouler chez différents clients, le nombre de barres de couleurs peut
varier. Je dois donc créer ces images par programmation. Je sais que cela
est possible mais comment accéder à leurs événements MouseDown, MouseMove
et
MouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler le
longueur des barres avec la souris. Tout celà doit se faire dans un
UserForm
car les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon application
doit rouler chez différents clients, le nombre de barres de couleurs peut
varier. Je dois donc créer ces images par programmation. Je sais que cela
est possible mais comment accéder à leurs événements MouseDown, MouseMove
et
MouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler le
longueur des barres avec la souris. Tout celà doit se faire dans un
UserForm
car les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon application
doit rouler chez différents clients, le nombre de barres de couleurs peut
varier. Je dois donc créer ces images par programmation. Je sais que cela
est possible mais comment accéder à leurs événements MouseDown, MouseMove
et
MouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler le
longueur des barres avec la souris. Tout celà doit se faire dans un
UserForm
car les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon application
doit rouler chez différents clients, le nombre de barres de couleurs peut
varier. Je dois donc créer ces images par programmation. Je sais que cela
est possible mais comment accéder à leurs événements MouseDown, MouseMove
et
MouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler le
longueur des barres avec la souris. Tout celà doit se faire dans un
UserForm
car les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon application
doit rouler chez différents clients, le nombre de barres de couleurs peut
varier. Je dois donc créer ces images par programmation. Je sais que cela
est possible mais comment accéder à leurs événements MouseDown, MouseMove
et
MouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler le
longueur des barres avec la souris. Tout celà doit se faire dans un
UserForm
car les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon application
doit rouler chez différents clients, le nombre de barres de couleurs peut
varier. Je dois donc créer ces images par programmation. Je sais que cela
est possible mais comment accéder à leurs événements MouseDown, MouseMove
et
MouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler le
longueur des barres avec la souris. Tout celà doit se faire dans un
UserForm
car les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Re Pierre;
Tu peux même largement simplifier l' ensemble en faisant appel à un module
de classe pour n'avoir qu'une seule procédure pour l'ensemble des barres
de
couleur. Par rapport à la solution précédente (l'userform s'appelle
UserForm2 et les données sont les mêmes que précédemment).
Dans un module de classe (Classe1):
Option Explicit
Public WithEvents Labs As MSForms.Label
Private Sub Labs_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
Y!)
lblName = Labs.Name
With UserForm2.lbl
.Left = Labs.Left
.Top = Labs.Top - 1
End With
End Sub
Dans un module standard:
Option Explicit
Public lblName As String
Sub Test2()
UserForm2.Show
End Sub
Dans le module Userform:
Option Explicit
Private lblArray() As New Classe1
Private Offset&
Private Sub lbl_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal Y!)
If Button = 1 Then
If (lbl.Top + Y) < 4 Then Exit Sub
If (lbl.Top + Y) > Offset - lbl.Height Then Exit Sub
lbl.Move , lbl.Top + Y
Controls(lblName).Top = lbl.Top + 1
Controls(lblName).Height = Offset - Controls(lblName).Top
End If
End Sub
Private Sub CtlInit(Ctl As Control, L%, t%, W%, H%, Optional S% = 0,
Optional b% = 0)
With Ctl
.Caption = ""
.Left = L
.Width = W
.BorderStyle = S
.BackStyle = b
.Height = H
.Top = t - H
End With
End Sub
Private Sub UserForm_Initialize()
Offset = 120 ' (Label1.Top + Label1.Height)
Call CtlInit(Label1, 6, 120, 24, 96, 1, 1)
Label1.BackColor = &HFF00&
Call CtlInit(Label2, 30, 120, 24, 84, 1, 1)
Label2.BackColor = &HFF&
Call CtlInit(lbl, 6, 120, 24, 2, 0, 0)
lbl.MousePointer = 7
'* Create the Labels objects
Dim Ctl As Control, i%
For Each Ctl In Me.Controls
If Left$(Ctl.Name, 5) = "Label" Then
i = Val(Mid(Ctl.Name, 6))
ReDim Preserve lblArray(1 To i)
Set lblArray(i).Labs = Ctl
End If
Next Ctl
End Sub
MP
"Pierre Archambault" a écrit dans le
message de news:Ypvod.70124$Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon
application
doit rouler chez différents clients, le nombre de barres de couleurs
peut
varier. Je dois donc créer ces images par programmation. Je sais que
cela
est possible mais comment accéder à leurs événements MouseDown,
MouseMove
etMouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler
le
longueur des barres avec la souris. Tout celà doit se faire dans un
UserFormcar les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Re Pierre;
Tu peux même largement simplifier l' ensemble en faisant appel à un module
de classe pour n'avoir qu'une seule procédure pour l'ensemble des barres
de
couleur. Par rapport à la solution précédente (l'userform s'appelle
UserForm2 et les données sont les mêmes que précédemment).
Dans un module de classe (Classe1):
Option Explicit
Public WithEvents Labs As MSForms.Label
Private Sub Labs_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
Y!)
lblName = Labs.Name
With UserForm2.lbl
.Left = Labs.Left
.Top = Labs.Top - 1
End With
End Sub
Dans un module standard:
Option Explicit
Public lblName As String
Sub Test2()
UserForm2.Show
End Sub
Dans le module Userform:
Option Explicit
Private lblArray() As New Classe1
Private Offset&
Private Sub lbl_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal Y!)
If Button = 1 Then
If (lbl.Top + Y) < 4 Then Exit Sub
If (lbl.Top + Y) > Offset - lbl.Height Then Exit Sub
lbl.Move , lbl.Top + Y
Controls(lblName).Top = lbl.Top + 1
Controls(lblName).Height = Offset - Controls(lblName).Top
End If
End Sub
Private Sub CtlInit(Ctl As Control, L%, t%, W%, H%, Optional S% = 0,
Optional b% = 0)
With Ctl
.Caption = ""
.Left = L
.Width = W
.BorderStyle = S
.BackStyle = b
.Height = H
.Top = t - H
End With
End Sub
Private Sub UserForm_Initialize()
Offset = 120 ' (Label1.Top + Label1.Height)
Call CtlInit(Label1, 6, 120, 24, 96, 1, 1)
Label1.BackColor = &HFF00&
Call CtlInit(Label2, 30, 120, 24, 84, 1, 1)
Label2.BackColor = &HFF&
Call CtlInit(lbl, 6, 120, 24, 2, 0, 0)
lbl.MousePointer = 7
'* Create the Labels objects
Dim Ctl As Control, i%
For Each Ctl In Me.Controls
If Left$(Ctl.Name, 5) = "Label" Then
i = Val(Mid(Ctl.Name, 6))
ReDim Preserve lblArray(1 To i)
Set lblArray(i).Labs = Ctl
End If
Next Ctl
End Sub
MP
"Pierre Archambault" <pierre.archambault@videotron.ca> a écrit dans le
message de news:Ypvod.70124$yx6.966686@weber.videotron.net...
Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon
application
doit rouler chez différents clients, le nombre de barres de couleurs
peut
varier. Je dois donc créer ces images par programmation. Je sais que
cela
est possible mais comment accéder à leurs événements MouseDown,
MouseMove
et
MouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler
le
longueur des barres avec la souris. Tout celà doit se faire dans un
UserForm
car les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Re Pierre;
Tu peux même largement simplifier l' ensemble en faisant appel à un module
de classe pour n'avoir qu'une seule procédure pour l'ensemble des barres
de
couleur. Par rapport à la solution précédente (l'userform s'appelle
UserForm2 et les données sont les mêmes que précédemment).
Dans un module de classe (Classe1):
Option Explicit
Public WithEvents Labs As MSForms.Label
Private Sub Labs_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal
Y!)
lblName = Labs.Name
With UserForm2.lbl
.Left = Labs.Left
.Top = Labs.Top - 1
End With
End Sub
Dans un module standard:
Option Explicit
Public lblName As String
Sub Test2()
UserForm2.Show
End Sub
Dans le module Userform:
Option Explicit
Private lblArray() As New Classe1
Private Offset&
Private Sub lbl_MouseMove(ByVal Button%, ByVal Shift%, ByVal x!, ByVal Y!)
If Button = 1 Then
If (lbl.Top + Y) < 4 Then Exit Sub
If (lbl.Top + Y) > Offset - lbl.Height Then Exit Sub
lbl.Move , lbl.Top + Y
Controls(lblName).Top = lbl.Top + 1
Controls(lblName).Height = Offset - Controls(lblName).Top
End If
End Sub
Private Sub CtlInit(Ctl As Control, L%, t%, W%, H%, Optional S% = 0,
Optional b% = 0)
With Ctl
.Caption = ""
.Left = L
.Width = W
.BorderStyle = S
.BackStyle = b
.Height = H
.Top = t - H
End With
End Sub
Private Sub UserForm_Initialize()
Offset = 120 ' (Label1.Top + Label1.Height)
Call CtlInit(Label1, 6, 120, 24, 96, 1, 1)
Label1.BackColor = &HFF00&
Call CtlInit(Label2, 30, 120, 24, 84, 1, 1)
Label2.BackColor = &HFF&
Call CtlInit(lbl, 6, 120, 24, 2, 0, 0)
lbl.MousePointer = 7
'* Create the Labels objects
Dim Ctl As Control, i%
For Each Ctl In Me.Controls
If Left$(Ctl.Name, 5) = "Label" Then
i = Val(Mid(Ctl.Name, 6))
ReDim Preserve lblArray(1 To i)
Set lblArray(i).Labs = Ctl
End If
Next Ctl
End Sub
MP
"Pierre Archambault" a écrit dans le
message de news:Ypvod.70124$Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon
application
doit rouler chez différents clients, le nombre de barres de couleurs
peut
varier. Je dois donc créer ces images par programmation. Je sais que
cela
est possible mais comment accéder à leurs événements MouseDown,
MouseMove
etMouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler
le
longueur des barres avec la souris. Tout celà doit se faire dans un
UserFormcar les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon application
doit rouler chez différents clients, le nombre de barres de couleurs peut
varier. Je dois donc créer ces images par programmation. Je sais que cela
est possible mais comment accéder à leurs événements MouseDown, MouseMove
et
MouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler le
longueur des barres avec la souris. Tout celà doit se faire dans un
UserForm
car les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon application
doit rouler chez différents clients, le nombre de barres de couleurs peut
varier. Je dois donc créer ces images par programmation. Je sais que cela
est possible mais comment accéder à leurs événements MouseDown, MouseMove
et
MouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler le
longueur des barres avec la souris. Tout celà doit se faire dans un
UserForm
car les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon application
doit rouler chez différents clients, le nombre de barres de couleurs peut
varier. Je dois donc créer ces images par programmation. Je sais que cela
est possible mais comment accéder à leurs événements MouseDown, MouseMove
et
MouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler le
longueur des barres avec la souris. Tout celà doit se faire dans un
UserForm
car les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Bonsoir Pierre;
Essaie le code ci-dessous qui crée à la demande des barres horizontales
redimensionnables et repositionnables dynamiquement par l'utilisateur.
Dans un module de classe:
Option Explicit
Public WithEvents Labels As MSForms.Label
Private iLock As Boolean
Private Sub Labels_MouseDown(ByVal Button%, ByVal Shift%, ByVal X!, ByVal
Y!)
iPos = X: iLock = (X >= Labels.Width - 4)
End Sub
Private Sub Labels_MouseMove(ByVal Button%, ByVal Shift%, ByVal X!, ByVal
Y!)
Dim R As Single
With Labels
If Button Then
If iLock Then ' Redimensionnement
If X < 6 Then .Width = 6: GoTo 1
R = iMax - xRef: If X > R Then .Width = R: GoTo 1
R = .Width - (.Width - X)
If .Left + R < iMax Then .Width = R
Else ' Positionnement
R = .Left - (iPos - X)
If R > xRef Then
If R + .Width > iMax Then .Left = iMax - .Width Else .Left = R
Else
.Left = xRef
End If
End If
End If
1: .Caption = "x:" & CInt(.Left - xRef) & " w:" & .Width
End With
End Sub
Private Sub Labels_MouseUp(ByVal Button%, ByVal Shift%, ByVal X!, ByVal
Y!)
iLock = False
End Sub
Dans un module standard:
Option Explicit
Public Const iVal As Byte = 6 ' Intervalle des barres
Public Const hLabel As Byte = 12 ' Hauteur des barres
Public Const wLabel As Byte = 96 ' Largeur des barres
Public Const xRef As Byte = 6 ' Point gauche min des barres
Public iPos!, iMax! ' iMax: Point droit max des barres
Sub Test()
UserForm1.Show
End Sub
Dans le module UserForm:
Option Explicit
Private Declare Function GetSystemMetrics& Lib "user32" (ByVal nIndex&)
Private lblArray() As New Classe1
Private Sub UserForm_Initialize()
Dim nBars%, Ctl As Control, i&, Q$
1: Q = InputBox("How many bars do you want ?" _
& vbLf & " (between 1 and 100)", , 25)
If Q = "" Then End
If Not IsNumeric(Q) Then GoTo 1 Else nBars = CInt(Q)
If nBars <= 0 Or nBars > 100 Then GoTo 1
' Bordures latérales
i = Me.Width - Me.InsideWidth
Me.Width = 12 + i + wLabel * 3
' Largeur utile - réserve à droite - largeur ScrollBar
iMax = Me.InsideWidth - 6 - GetSystemMetrics(9) * 3 / 4
' Hauteur Titre + bordure inférieure
i = Me.Height - Me.InsideHeight
Me.Height = 12 + i + (hLabel + iVal) * 10 - iVal
Me.ScrollBars = 2
Me.ScrollHeight = (hLabel + iVal) * nBars + iVal
For i = 1 To nBars
Set Ctl = Me.Controls.Add("forms.label.1", "Label" & i, True)
With Ctl
.BorderStyle = 1
.Top = 6 + (i - 1) * (hLabel + iVal)
.Left = xRef
.Width = Int((wLabel * Rnd) + 36)
.Height = hLabel
.BackColor = RGB(Int((255 * Rnd) + 1), Int((255 * Rnd) + 1), Int((255 *
Rnd)
+ 1))
.Caption = "x:0" & " w:" & .Width
.ControlTipText = .Name
.MousePointer = 9
End With
ReDim Preserve lblArray(i)
Set lblArray(i).Labels = Ctl
Next i
Set Ctl = Nothing
End Sub
MP
"Pierre Archambault" a écrit dans le
message de news:Ypvod.70124$Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon
application
doit rouler chez différents clients, le nombre de barres de couleurs
peut
varier. Je dois donc créer ces images par programmation. Je sais que
cela
est possible mais comment accéder à leurs événements MouseDown,
MouseMove
etMouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler
le
longueur des barres avec la souris. Tout celà doit se faire dans un
UserFormcar les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Bonsoir Pierre;
Essaie le code ci-dessous qui crée à la demande des barres horizontales
redimensionnables et repositionnables dynamiquement par l'utilisateur.
Dans un module de classe:
Option Explicit
Public WithEvents Labels As MSForms.Label
Private iLock As Boolean
Private Sub Labels_MouseDown(ByVal Button%, ByVal Shift%, ByVal X!, ByVal
Y!)
iPos = X: iLock = (X >= Labels.Width - 4)
End Sub
Private Sub Labels_MouseMove(ByVal Button%, ByVal Shift%, ByVal X!, ByVal
Y!)
Dim R As Single
With Labels
If Button Then
If iLock Then ' Redimensionnement
If X < 6 Then .Width = 6: GoTo 1
R = iMax - xRef: If X > R Then .Width = R: GoTo 1
R = .Width - (.Width - X)
If .Left + R < iMax Then .Width = R
Else ' Positionnement
R = .Left - (iPos - X)
If R > xRef Then
If R + .Width > iMax Then .Left = iMax - .Width Else .Left = R
Else
.Left = xRef
End If
End If
End If
1: .Caption = "x:" & CInt(.Left - xRef) & " w:" & .Width
End With
End Sub
Private Sub Labels_MouseUp(ByVal Button%, ByVal Shift%, ByVal X!, ByVal
Y!)
iLock = False
End Sub
Dans un module standard:
Option Explicit
Public Const iVal As Byte = 6 ' Intervalle des barres
Public Const hLabel As Byte = 12 ' Hauteur des barres
Public Const wLabel As Byte = 96 ' Largeur des barres
Public Const xRef As Byte = 6 ' Point gauche min des barres
Public iPos!, iMax! ' iMax: Point droit max des barres
Sub Test()
UserForm1.Show
End Sub
Dans le module UserForm:
Option Explicit
Private Declare Function GetSystemMetrics& Lib "user32" (ByVal nIndex&)
Private lblArray() As New Classe1
Private Sub UserForm_Initialize()
Dim nBars%, Ctl As Control, i&, Q$
1: Q = InputBox("How many bars do you want ?" _
& vbLf & " (between 1 and 100)", , 25)
If Q = "" Then End
If Not IsNumeric(Q) Then GoTo 1 Else nBars = CInt(Q)
If nBars <= 0 Or nBars > 100 Then GoTo 1
' Bordures latérales
i = Me.Width - Me.InsideWidth
Me.Width = 12 + i + wLabel * 3
' Largeur utile - réserve à droite - largeur ScrollBar
iMax = Me.InsideWidth - 6 - GetSystemMetrics(9) * 3 / 4
' Hauteur Titre + bordure inférieure
i = Me.Height - Me.InsideHeight
Me.Height = 12 + i + (hLabel + iVal) * 10 - iVal
Me.ScrollBars = 2
Me.ScrollHeight = (hLabel + iVal) * nBars + iVal
For i = 1 To nBars
Set Ctl = Me.Controls.Add("forms.label.1", "Label" & i, True)
With Ctl
.BorderStyle = 1
.Top = 6 + (i - 1) * (hLabel + iVal)
.Left = xRef
.Width = Int((wLabel * Rnd) + 36)
.Height = hLabel
.BackColor = RGB(Int((255 * Rnd) + 1), Int((255 * Rnd) + 1), Int((255 *
Rnd)
+ 1))
.Caption = "x:0" & " w:" & .Width
.ControlTipText = .Name
.MousePointer = 9
End With
ReDim Preserve lblArray(i)
Set lblArray(i).Labels = Ctl
Next i
Set Ctl = Nothing
End Sub
MP
"Pierre Archambault" <pierre.archambault@videotron.ca> a écrit dans le
message de news:Ypvod.70124$yx6.966686@weber.videotron.net...
Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon
application
doit rouler chez différents clients, le nombre de barres de couleurs
peut
varier. Je dois donc créer ces images par programmation. Je sais que
cela
est possible mais comment accéder à leurs événements MouseDown,
MouseMove
et
MouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler
le
longueur des barres avec la souris. Tout celà doit se faire dans un
UserForm
car les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Bonsoir Pierre;
Essaie le code ci-dessous qui crée à la demande des barres horizontales
redimensionnables et repositionnables dynamiquement par l'utilisateur.
Dans un module de classe:
Option Explicit
Public WithEvents Labels As MSForms.Label
Private iLock As Boolean
Private Sub Labels_MouseDown(ByVal Button%, ByVal Shift%, ByVal X!, ByVal
Y!)
iPos = X: iLock = (X >= Labels.Width - 4)
End Sub
Private Sub Labels_MouseMove(ByVal Button%, ByVal Shift%, ByVal X!, ByVal
Y!)
Dim R As Single
With Labels
If Button Then
If iLock Then ' Redimensionnement
If X < 6 Then .Width = 6: GoTo 1
R = iMax - xRef: If X > R Then .Width = R: GoTo 1
R = .Width - (.Width - X)
If .Left + R < iMax Then .Width = R
Else ' Positionnement
R = .Left - (iPos - X)
If R > xRef Then
If R + .Width > iMax Then .Left = iMax - .Width Else .Left = R
Else
.Left = xRef
End If
End If
End If
1: .Caption = "x:" & CInt(.Left - xRef) & " w:" & .Width
End With
End Sub
Private Sub Labels_MouseUp(ByVal Button%, ByVal Shift%, ByVal X!, ByVal
Y!)
iLock = False
End Sub
Dans un module standard:
Option Explicit
Public Const iVal As Byte = 6 ' Intervalle des barres
Public Const hLabel As Byte = 12 ' Hauteur des barres
Public Const wLabel As Byte = 96 ' Largeur des barres
Public Const xRef As Byte = 6 ' Point gauche min des barres
Public iPos!, iMax! ' iMax: Point droit max des barres
Sub Test()
UserForm1.Show
End Sub
Dans le module UserForm:
Option Explicit
Private Declare Function GetSystemMetrics& Lib "user32" (ByVal nIndex&)
Private lblArray() As New Classe1
Private Sub UserForm_Initialize()
Dim nBars%, Ctl As Control, i&, Q$
1: Q = InputBox("How many bars do you want ?" _
& vbLf & " (between 1 and 100)", , 25)
If Q = "" Then End
If Not IsNumeric(Q) Then GoTo 1 Else nBars = CInt(Q)
If nBars <= 0 Or nBars > 100 Then GoTo 1
' Bordures latérales
i = Me.Width - Me.InsideWidth
Me.Width = 12 + i + wLabel * 3
' Largeur utile - réserve à droite - largeur ScrollBar
iMax = Me.InsideWidth - 6 - GetSystemMetrics(9) * 3 / 4
' Hauteur Titre + bordure inférieure
i = Me.Height - Me.InsideHeight
Me.Height = 12 + i + (hLabel + iVal) * 10 - iVal
Me.ScrollBars = 2
Me.ScrollHeight = (hLabel + iVal) * nBars + iVal
For i = 1 To nBars
Set Ctl = Me.Controls.Add("forms.label.1", "Label" & i, True)
With Ctl
.BorderStyle = 1
.Top = 6 + (i - 1) * (hLabel + iVal)
.Left = xRef
.Width = Int((wLabel * Rnd) + 36)
.Height = hLabel
.BackColor = RGB(Int((255 * Rnd) + 1), Int((255 * Rnd) + 1), Int((255 *
Rnd)
+ 1))
.Caption = "x:0" & " w:" & .Width
.ControlTipText = .Name
.MousePointer = 9
End With
ReDim Preserve lblArray(i)
Set lblArray(i).Labels = Ctl
Next i
Set Ctl = Nothing
End Sub
MP
"Pierre Archambault" a écrit dans le
message de news:Ypvod.70124$Bonjour,
Mon problème est le suivant.
Je dois représenter graphiquement des durées en heures par des barres de
couleurs de longueur différentes (contrôles images). Comme mon
application
doit rouler chez différents clients, le nombre de barres de couleurs
peut
varier. Je dois donc créer ces images par programmation. Je sais que
cela
est possible mais comment accéder à leurs événements MouseDown,
MouseMove
etMouseUp. Le contrôle n'étant pas disponible en mode création, je ne peux
donc pas écrire de code dans ces événements. Je veux pouvoir contrôler
le
longueur des barres avec la souris. Tout celà doit se faire dans un
UserFormcar les données sous-jacentes ne sont pas accessible directement par
l'usager; toute l'application se déroule par le biais de UserForms.
Merci de votre aide.
Pierre
Salut Michel,
Vraiement fort ! C'est encore plus compact que mon code. Je vais sûrement
m'en servir, merci.
Un autre défi... Toujours dans la même veine, je dois ajouter d'autres
barres à celles-ci.
Je t'explique la situation:
Les barres que nous venons de créer représentent du temps de travail
(horaire régulier: la longueur représente le temps travaillé). Je dois
aussi
prévoir d'autres barres également de couleurs différentes qui, elles,
représenteront le temps supplémentaire effectué le même jour. À chaque
barre
"régulière" correspond une barre "supplémentaire". La barre supplémentaire
pourrait avoir une longueur de 0; il peut arriver qu'il n'y ait pas de
temps
supplémentaire.
J'ai prévu la superposer avec sa barre régulière correspondante mais d'une
hauteur moindre de façon que l'on voit encore la barre "régulière" en
dessous. Jusqu'ici pas de problème. Cette deuxième série de barres ("temps
supplémentaire") pourra aussi être déplacée mais il y a un écueil.
Lorsque je déplace la barre régulière et que je tente de synchroniser la
propriété .Left de la barre supplémentaire avec la valeur de cette
propriété
de la barre régulière, j'ai ce message d'erreur :
Variable objet ou variable de bloc With non définie.
Si tu regarde le code qui a servi à créer ma première collection, je m'en
suis servi pour créer la deuxième.
Voici le bout de code en question (Ici je crée également une collection de
labels)
-----------------------------------------------------
For i = 1 To NbreDeBarres
' Images du temps régulier
NomImage = "ImgRég" & Str(NumImage)
NumImage = NumImage + 1
ListeImages.Add Item:=ObjetClasse, key:=CStr(NumImage)
Set ObjetClasse = Nothing
Set ListeImages.Item(NumImage).ImageRég_Prog > UserForm1.Frame1.Controls.Add("Forms.Image.1", NomImage)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeImages.Item(NumImage).ImageRég_Prog
.BorderStyle = fmBorderStyleSingle
.Top = Placement
.Left = PointAppui
.Width = LargeurImage / 4.45 * 4 'Facteur pour faire correspondre
avec la grille de fond
.Height = HauteurImage
.BackColor = vbGreen
End With
'Images du temps supplémentaire
NomImgSup = "ImgSup" & Str(NumImage)
NumSupp = NumSupp + 1
ListeImgSup.Add Item:=ObjetClasse, key:=CStr(NumSupp)
Set ObjetClasse = Nothing
Set ListeImgSup.Item(NumSupp).ImageSupp_Prog > UserForm1.Frame1.Controls.Add("Forms.Image.1", NomImgSup)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeImgSup.Item(NumSupp).ImageSupp_Prog
.BorderStyle = fmBorderStyleNone
.Top = Placement + 1.5
.Left = PointAppui
.Width = (LargeurImage * FacteurAjust) / 4
.Height = HauteurImage - 3
.BackColor = vbRed
End With
'Labels noms de départements
NomLabel = "Lbl" & Str(NumLabel) '& Tableau(i)
NumLabel = NumLabel + 1
ListeLabels.Add Item:=ObjetClasse, key:=CStr(NumLabel)
Set ObjetClasse = Nothing
Set ListeLabels.Item(NumLabel).Label_Prog > UserForm1.Frame1.Controls.Add("Forms.label.1", NomLabel)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeLabels.Item(NumLabel).Label_Prog
.BorderStyle = fmBorderStyleNone
.BackStyle = fmBackStyleTransparent
.Caption = NomLabel
.WordWrap = False
.Top = Placement
.Left = 2
.Width = imgGauche.Width
.Height = HauteurImage + 5
.Font.Size = 7
.Font.Bold = True
End With
Next i
-----------------------------------------------------
Et c'est dans le module de classe que l'erreur survient.
-----------------------------------------------------
Private Sub ImageRég_Prog_MouseMove(ByVal Button As Integer, ByVal Shift
As
Integer, ByVal X As Single, ByVal Y As Single)
ImageRég_Prog.MousePointer = fmMousePointerSizeWE
If Button = 1 Then
If Pressé Then
If X > Position Then
ImageRég_Prog.Move Left:=(ImageRég_Prog.Left + (X - Position))
ImageSupp_Prog.Left = ImageRég_Prog.Left '< Erreur:
Variable objet ou variable de bloc With non définie.
Else
ImageRég_Prog.Move Left:=(ImageRég_Prog.Left - (Position - X))
ImageSupp_Prog.Left = ImageRég_Prog.Left '< Erreur:
Variable objet ou variable de bloc With non définie.
If ImageRég_Prog.Left < PointAppui Then
ImageRég_Prog.Left = PointAppui
End If
End If
End If
End If
End Sub
-----------------------------------------------------
Dis-moi que cela ne se produira pas avec ta technique...
Merci encore.
Pierre
-----------------------------------------------------
Salut Michel,
Vraiement fort ! C'est encore plus compact que mon code. Je vais sûrement
m'en servir, merci.
Un autre défi... Toujours dans la même veine, je dois ajouter d'autres
barres à celles-ci.
Je t'explique la situation:
Les barres que nous venons de créer représentent du temps de travail
(horaire régulier: la longueur représente le temps travaillé). Je dois
aussi
prévoir d'autres barres également de couleurs différentes qui, elles,
représenteront le temps supplémentaire effectué le même jour. À chaque
barre
"régulière" correspond une barre "supplémentaire". La barre supplémentaire
pourrait avoir une longueur de 0; il peut arriver qu'il n'y ait pas de
temps
supplémentaire.
J'ai prévu la superposer avec sa barre régulière correspondante mais d'une
hauteur moindre de façon que l'on voit encore la barre "régulière" en
dessous. Jusqu'ici pas de problème. Cette deuxième série de barres ("temps
supplémentaire") pourra aussi être déplacée mais il y a un écueil.
Lorsque je déplace la barre régulière et que je tente de synchroniser la
propriété .Left de la barre supplémentaire avec la valeur de cette
propriété
de la barre régulière, j'ai ce message d'erreur :
Variable objet ou variable de bloc With non définie.
Si tu regarde le code qui a servi à créer ma première collection, je m'en
suis servi pour créer la deuxième.
Voici le bout de code en question (Ici je crée également une collection de
labels)
-----------------------------------------------------
For i = 1 To NbreDeBarres
' Images du temps régulier
NomImage = "ImgRég" & Str(NumImage)
NumImage = NumImage + 1
ListeImages.Add Item:=ObjetClasse, key:=CStr(NumImage)
Set ObjetClasse = Nothing
Set ListeImages.Item(NumImage).ImageRég_Prog > UserForm1.Frame1.Controls.Add("Forms.Image.1", NomImage)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeImages.Item(NumImage).ImageRég_Prog
.BorderStyle = fmBorderStyleSingle
.Top = Placement
.Left = PointAppui
.Width = LargeurImage / 4.45 * 4 'Facteur pour faire correspondre
avec la grille de fond
.Height = HauteurImage
.BackColor = vbGreen
End With
'Images du temps supplémentaire
NomImgSup = "ImgSup" & Str(NumImage)
NumSupp = NumSupp + 1
ListeImgSup.Add Item:=ObjetClasse, key:=CStr(NumSupp)
Set ObjetClasse = Nothing
Set ListeImgSup.Item(NumSupp).ImageSupp_Prog > UserForm1.Frame1.Controls.Add("Forms.Image.1", NomImgSup)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeImgSup.Item(NumSupp).ImageSupp_Prog
.BorderStyle = fmBorderStyleNone
.Top = Placement + 1.5
.Left = PointAppui
.Width = (LargeurImage * FacteurAjust) / 4
.Height = HauteurImage - 3
.BackColor = vbRed
End With
'Labels noms de départements
NomLabel = "Lbl" & Str(NumLabel) '& Tableau(i)
NumLabel = NumLabel + 1
ListeLabels.Add Item:=ObjetClasse, key:=CStr(NumLabel)
Set ObjetClasse = Nothing
Set ListeLabels.Item(NumLabel).Label_Prog > UserForm1.Frame1.Controls.Add("Forms.label.1", NomLabel)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeLabels.Item(NumLabel).Label_Prog
.BorderStyle = fmBorderStyleNone
.BackStyle = fmBackStyleTransparent
.Caption = NomLabel
.WordWrap = False
.Top = Placement
.Left = 2
.Width = imgGauche.Width
.Height = HauteurImage + 5
.Font.Size = 7
.Font.Bold = True
End With
Next i
-----------------------------------------------------
Et c'est dans le module de classe que l'erreur survient.
-----------------------------------------------------
Private Sub ImageRég_Prog_MouseMove(ByVal Button As Integer, ByVal Shift
As
Integer, ByVal X As Single, ByVal Y As Single)
ImageRég_Prog.MousePointer = fmMousePointerSizeWE
If Button = 1 Then
If Pressé Then
If X > Position Then
ImageRég_Prog.Move Left:=(ImageRég_Prog.Left + (X - Position))
ImageSupp_Prog.Left = ImageRég_Prog.Left '< Erreur:
Variable objet ou variable de bloc With non définie.
Else
ImageRég_Prog.Move Left:=(ImageRég_Prog.Left - (Position - X))
ImageSupp_Prog.Left = ImageRég_Prog.Left '< Erreur:
Variable objet ou variable de bloc With non définie.
If ImageRég_Prog.Left < PointAppui Then
ImageRég_Prog.Left = PointAppui
End If
End If
End If
End If
End Sub
-----------------------------------------------------
Dis-moi que cela ne se produira pas avec ta technique...
Merci encore.
Pierre
-----------------------------------------------------
Salut Michel,
Vraiement fort ! C'est encore plus compact que mon code. Je vais sûrement
m'en servir, merci.
Un autre défi... Toujours dans la même veine, je dois ajouter d'autres
barres à celles-ci.
Je t'explique la situation:
Les barres que nous venons de créer représentent du temps de travail
(horaire régulier: la longueur représente le temps travaillé). Je dois
aussi
prévoir d'autres barres également de couleurs différentes qui, elles,
représenteront le temps supplémentaire effectué le même jour. À chaque
barre
"régulière" correspond une barre "supplémentaire". La barre supplémentaire
pourrait avoir une longueur de 0; il peut arriver qu'il n'y ait pas de
temps
supplémentaire.
J'ai prévu la superposer avec sa barre régulière correspondante mais d'une
hauteur moindre de façon que l'on voit encore la barre "régulière" en
dessous. Jusqu'ici pas de problème. Cette deuxième série de barres ("temps
supplémentaire") pourra aussi être déplacée mais il y a un écueil.
Lorsque je déplace la barre régulière et que je tente de synchroniser la
propriété .Left de la barre supplémentaire avec la valeur de cette
propriété
de la barre régulière, j'ai ce message d'erreur :
Variable objet ou variable de bloc With non définie.
Si tu regarde le code qui a servi à créer ma première collection, je m'en
suis servi pour créer la deuxième.
Voici le bout de code en question (Ici je crée également une collection de
labels)
-----------------------------------------------------
For i = 1 To NbreDeBarres
' Images du temps régulier
NomImage = "ImgRég" & Str(NumImage)
NumImage = NumImage + 1
ListeImages.Add Item:=ObjetClasse, key:=CStr(NumImage)
Set ObjetClasse = Nothing
Set ListeImages.Item(NumImage).ImageRég_Prog > UserForm1.Frame1.Controls.Add("Forms.Image.1", NomImage)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeImages.Item(NumImage).ImageRég_Prog
.BorderStyle = fmBorderStyleSingle
.Top = Placement
.Left = PointAppui
.Width = LargeurImage / 4.45 * 4 'Facteur pour faire correspondre
avec la grille de fond
.Height = HauteurImage
.BackColor = vbGreen
End With
'Images du temps supplémentaire
NomImgSup = "ImgSup" & Str(NumImage)
NumSupp = NumSupp + 1
ListeImgSup.Add Item:=ObjetClasse, key:=CStr(NumSupp)
Set ObjetClasse = Nothing
Set ListeImgSup.Item(NumSupp).ImageSupp_Prog > UserForm1.Frame1.Controls.Add("Forms.Image.1", NomImgSup)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeImgSup.Item(NumSupp).ImageSupp_Prog
.BorderStyle = fmBorderStyleNone
.Top = Placement + 1.5
.Left = PointAppui
.Width = (LargeurImage * FacteurAjust) / 4
.Height = HauteurImage - 3
.BackColor = vbRed
End With
'Labels noms de départements
NomLabel = "Lbl" & Str(NumLabel) '& Tableau(i)
NumLabel = NumLabel + 1
ListeLabels.Add Item:=ObjetClasse, key:=CStr(NumLabel)
Set ObjetClasse = Nothing
Set ListeLabels.Item(NumLabel).Label_Prog > UserForm1.Frame1.Controls.Add("Forms.label.1", NomLabel)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeLabels.Item(NumLabel).Label_Prog
.BorderStyle = fmBorderStyleNone
.BackStyle = fmBackStyleTransparent
.Caption = NomLabel
.WordWrap = False
.Top = Placement
.Left = 2
.Width = imgGauche.Width
.Height = HauteurImage + 5
.Font.Size = 7
.Font.Bold = True
End With
Next i
-----------------------------------------------------
Et c'est dans le module de classe que l'erreur survient.
-----------------------------------------------------
Private Sub ImageRég_Prog_MouseMove(ByVal Button As Integer, ByVal Shift
As
Integer, ByVal X As Single, ByVal Y As Single)
ImageRég_Prog.MousePointer = fmMousePointerSizeWE
If Button = 1 Then
If Pressé Then
If X > Position Then
ImageRég_Prog.Move Left:=(ImageRég_Prog.Left + (X - Position))
ImageSupp_Prog.Left = ImageRég_Prog.Left '< Erreur:
Variable objet ou variable de bloc With non définie.
Else
ImageRég_Prog.Move Left:=(ImageRég_Prog.Left - (Position - X))
ImageSupp_Prog.Left = ImageRég_Prog.Left '< Erreur:
Variable objet ou variable de bloc With non définie.
If ImageRég_Prog.Left < PointAppui Then
ImageRég_Prog.Left = PointAppui
End If
End If
End If
End If
End Sub
-----------------------------------------------------
Dis-moi que cela ne se produira pas avec ta technique...
Merci encore.
Pierre
-----------------------------------------------------
Bonsoir Pierre;
Pour moi, ça baigne; aucun souci avec ma technique alors qu'avec la
tienne,
j'ai la même erreur que toi.
MP
"Pierre Archambault" a écrit dans le
message de news:2hqpd.22038$Salut Michel,
Vraiement fort ! C'est encore plus compact que mon code. Je vais
sûrement
m'en servir, merci.
Un autre défi... Toujours dans la même veine, je dois ajouter d'autres
barres à celles-ci.
Je t'explique la situation:
Les barres que nous venons de créer représentent du temps de travail
(horaire régulier: la longueur représente le temps travaillé). Je dois
aussiprévoir d'autres barres également de couleurs différentes qui, elles,
représenteront le temps supplémentaire effectué le même jour. À chaque
barre"régulière" correspond une barre "supplémentaire". La barre
supplémentaire
pourrait avoir une longueur de 0; il peut arriver qu'il n'y ait pas de
tempssupplémentaire.
J'ai prévu la superposer avec sa barre régulière correspondante mais
d'une
hauteur moindre de façon que l'on voit encore la barre "régulière" en
dessous. Jusqu'ici pas de problème. Cette deuxième série de barres
("temps
supplémentaire") pourra aussi être déplacée mais il y a un écueil.
Lorsque je déplace la barre régulière et que je tente de synchroniser la
propriété .Left de la barre supplémentaire avec la valeur de cette
propriétéde la barre régulière, j'ai ce message d'erreur :
Variable objet ou variable de bloc With non définie.
Si tu regarde le code qui a servi à créer ma première collection, je
m'en
suis servi pour créer la deuxième.
Voici le bout de code en question (Ici je crée également une collection
de
labels)
-----------------------------------------------------
For i = 1 To NbreDeBarres
' Images du temps régulier
NomImage = "ImgRég" & Str(NumImage)
NumImage = NumImage + 1
ListeImages.Add Item:=ObjetClasse, key:=CStr(NumImage)
Set ObjetClasse = Nothing
Set ListeImages.Item(NumImage).ImageRég_Prog > > UserForm1.Frame1.Controls.Add("Forms.Image.1", NomImage)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeImages.Item(NumImage).ImageRég_Prog
.BorderStyle = fmBorderStyleSingle
.Top = Placement
.Left = PointAppui
.Width = LargeurImage / 4.45 * 4 'Facteur pour faire
correspondre
avec la grille de fond
.Height = HauteurImage
.BackColor = vbGreen
End With
'Images du temps supplémentaire
NomImgSup = "ImgSup" & Str(NumImage)
NumSupp = NumSupp + 1
ListeImgSup.Add Item:=ObjetClasse, key:=CStr(NumSupp)
Set ObjetClasse = Nothing
Set ListeImgSup.Item(NumSupp).ImageSupp_Prog > > UserForm1.Frame1.Controls.Add("Forms.Image.1", NomImgSup)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeImgSup.Item(NumSupp).ImageSupp_Prog
.BorderStyle = fmBorderStyleNone
.Top = Placement + 1.5
.Left = PointAppui
.Width = (LargeurImage * FacteurAjust) / 4
.Height = HauteurImage - 3
.BackColor = vbRed
End With
'Labels noms de départements
NomLabel = "Lbl" & Str(NumLabel) '& Tableau(i)
NumLabel = NumLabel + 1
ListeLabels.Add Item:=ObjetClasse, key:=CStr(NumLabel)
Set ObjetClasse = Nothing
Set ListeLabels.Item(NumLabel).Label_Prog > > UserForm1.Frame1.Controls.Add("Forms.label.1", NomLabel)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeLabels.Item(NumLabel).Label_Prog
.BorderStyle = fmBorderStyleNone
.BackStyle = fmBackStyleTransparent
.Caption = NomLabel
.WordWrap = False
.Top = Placement
.Left = 2
.Width = imgGauche.Width
.Height = HauteurImage + 5
.Font.Size = 7
.Font.Bold = True
End With
Next i
-----------------------------------------------------
Et c'est dans le module de classe que l'erreur survient.
-----------------------------------------------------
Private Sub ImageRég_Prog_MouseMove(ByVal Button As Integer, ByVal Shift
AsInteger, ByVal X As Single, ByVal Y As Single)
ImageRég_Prog.MousePointer = fmMousePointerSizeWE
If Button = 1 Then
If Pressé Then
If X > Position Then
ImageRég_Prog.Move Left:=(ImageRég_Prog.Left + (X -
Position))
ImageSupp_Prog.Left = ImageRég_Prog.Left '< Erreur:
Variable objet ou variable de bloc With non définie.
Else
ImageRég_Prog.Move Left:=(ImageRég_Prog.Left - (Position -
X))
ImageSupp_Prog.Left = ImageRég_Prog.Left '< Erreur:
Variable objet ou variable de bloc With non définie.
If ImageRég_Prog.Left < PointAppui Then
ImageRég_Prog.Left = PointAppui
End If
End If
End If
End If
End Sub
-----------------------------------------------------
Dis-moi que cela ne se produira pas avec ta technique...
Merci encore.
Pierre
-----------------------------------------------------
Bonsoir Pierre;
Pour moi, ça baigne; aucun souci avec ma technique alors qu'avec la
tienne,
j'ai la même erreur que toi.
MP
"Pierre Archambault" <pierre.archambault@videotron.ca> a écrit dans le
message de news:2hqpd.22038$i_4.185380@weber.videotron.net...
Salut Michel,
Vraiement fort ! C'est encore plus compact que mon code. Je vais
sûrement
m'en servir, merci.
Un autre défi... Toujours dans la même veine, je dois ajouter d'autres
barres à celles-ci.
Je t'explique la situation:
Les barres que nous venons de créer représentent du temps de travail
(horaire régulier: la longueur représente le temps travaillé). Je dois
aussi
prévoir d'autres barres également de couleurs différentes qui, elles,
représenteront le temps supplémentaire effectué le même jour. À chaque
barre
"régulière" correspond une barre "supplémentaire". La barre
supplémentaire
pourrait avoir une longueur de 0; il peut arriver qu'il n'y ait pas de
temps
supplémentaire.
J'ai prévu la superposer avec sa barre régulière correspondante mais
d'une
hauteur moindre de façon que l'on voit encore la barre "régulière" en
dessous. Jusqu'ici pas de problème. Cette deuxième série de barres
("temps
supplémentaire") pourra aussi être déplacée mais il y a un écueil.
Lorsque je déplace la barre régulière et que je tente de synchroniser la
propriété .Left de la barre supplémentaire avec la valeur de cette
propriété
de la barre régulière, j'ai ce message d'erreur :
Variable objet ou variable de bloc With non définie.
Si tu regarde le code qui a servi à créer ma première collection, je
m'en
suis servi pour créer la deuxième.
Voici le bout de code en question (Ici je crée également une collection
de
labels)
-----------------------------------------------------
For i = 1 To NbreDeBarres
' Images du temps régulier
NomImage = "ImgRég" & Str(NumImage)
NumImage = NumImage + 1
ListeImages.Add Item:=ObjetClasse, key:=CStr(NumImage)
Set ObjetClasse = Nothing
Set ListeImages.Item(NumImage).ImageRég_Prog > > UserForm1.Frame1.Controls.Add("Forms.Image.1", NomImage)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeImages.Item(NumImage).ImageRég_Prog
.BorderStyle = fmBorderStyleSingle
.Top = Placement
.Left = PointAppui
.Width = LargeurImage / 4.45 * 4 'Facteur pour faire
correspondre
avec la grille de fond
.Height = HauteurImage
.BackColor = vbGreen
End With
'Images du temps supplémentaire
NomImgSup = "ImgSup" & Str(NumImage)
NumSupp = NumSupp + 1
ListeImgSup.Add Item:=ObjetClasse, key:=CStr(NumSupp)
Set ObjetClasse = Nothing
Set ListeImgSup.Item(NumSupp).ImageSupp_Prog > > UserForm1.Frame1.Controls.Add("Forms.Image.1", NomImgSup)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeImgSup.Item(NumSupp).ImageSupp_Prog
.BorderStyle = fmBorderStyleNone
.Top = Placement + 1.5
.Left = PointAppui
.Width = (LargeurImage * FacteurAjust) / 4
.Height = HauteurImage - 3
.BackColor = vbRed
End With
'Labels noms de départements
NomLabel = "Lbl" & Str(NumLabel) '& Tableau(i)
NumLabel = NumLabel + 1
ListeLabels.Add Item:=ObjetClasse, key:=CStr(NumLabel)
Set ObjetClasse = Nothing
Set ListeLabels.Item(NumLabel).Label_Prog > > UserForm1.Frame1.Controls.Add("Forms.label.1", NomLabel)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeLabels.Item(NumLabel).Label_Prog
.BorderStyle = fmBorderStyleNone
.BackStyle = fmBackStyleTransparent
.Caption = NomLabel
.WordWrap = False
.Top = Placement
.Left = 2
.Width = imgGauche.Width
.Height = HauteurImage + 5
.Font.Size = 7
.Font.Bold = True
End With
Next i
-----------------------------------------------------
Et c'est dans le module de classe que l'erreur survient.
-----------------------------------------------------
Private Sub ImageRég_Prog_MouseMove(ByVal Button As Integer, ByVal Shift
As
Integer, ByVal X As Single, ByVal Y As Single)
ImageRég_Prog.MousePointer = fmMousePointerSizeWE
If Button = 1 Then
If Pressé Then
If X > Position Then
ImageRég_Prog.Move Left:=(ImageRég_Prog.Left + (X -
Position))
ImageSupp_Prog.Left = ImageRég_Prog.Left '< Erreur:
Variable objet ou variable de bloc With non définie.
Else
ImageRég_Prog.Move Left:=(ImageRég_Prog.Left - (Position -
X))
ImageSupp_Prog.Left = ImageRég_Prog.Left '< Erreur:
Variable objet ou variable de bloc With non définie.
If ImageRég_Prog.Left < PointAppui Then
ImageRég_Prog.Left = PointAppui
End If
End If
End If
End If
End Sub
-----------------------------------------------------
Dis-moi que cela ne se produira pas avec ta technique...
Merci encore.
Pierre
-----------------------------------------------------
Bonsoir Pierre;
Pour moi, ça baigne; aucun souci avec ma technique alors qu'avec la
tienne,
j'ai la même erreur que toi.
MP
"Pierre Archambault" a écrit dans le
message de news:2hqpd.22038$Salut Michel,
Vraiement fort ! C'est encore plus compact que mon code. Je vais
sûrement
m'en servir, merci.
Un autre défi... Toujours dans la même veine, je dois ajouter d'autres
barres à celles-ci.
Je t'explique la situation:
Les barres que nous venons de créer représentent du temps de travail
(horaire régulier: la longueur représente le temps travaillé). Je dois
aussiprévoir d'autres barres également de couleurs différentes qui, elles,
représenteront le temps supplémentaire effectué le même jour. À chaque
barre"régulière" correspond une barre "supplémentaire". La barre
supplémentaire
pourrait avoir une longueur de 0; il peut arriver qu'il n'y ait pas de
tempssupplémentaire.
J'ai prévu la superposer avec sa barre régulière correspondante mais
d'une
hauteur moindre de façon que l'on voit encore la barre "régulière" en
dessous. Jusqu'ici pas de problème. Cette deuxième série de barres
("temps
supplémentaire") pourra aussi être déplacée mais il y a un écueil.
Lorsque je déplace la barre régulière et que je tente de synchroniser la
propriété .Left de la barre supplémentaire avec la valeur de cette
propriétéde la barre régulière, j'ai ce message d'erreur :
Variable objet ou variable de bloc With non définie.
Si tu regarde le code qui a servi à créer ma première collection, je
m'en
suis servi pour créer la deuxième.
Voici le bout de code en question (Ici je crée également une collection
de
labels)
-----------------------------------------------------
For i = 1 To NbreDeBarres
' Images du temps régulier
NomImage = "ImgRég" & Str(NumImage)
NumImage = NumImage + 1
ListeImages.Add Item:=ObjetClasse, key:=CStr(NumImage)
Set ObjetClasse = Nothing
Set ListeImages.Item(NumImage).ImageRég_Prog > > UserForm1.Frame1.Controls.Add("Forms.Image.1", NomImage)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeImages.Item(NumImage).ImageRég_Prog
.BorderStyle = fmBorderStyleSingle
.Top = Placement
.Left = PointAppui
.Width = LargeurImage / 4.45 * 4 'Facteur pour faire
correspondre
avec la grille de fond
.Height = HauteurImage
.BackColor = vbGreen
End With
'Images du temps supplémentaire
NomImgSup = "ImgSup" & Str(NumImage)
NumSupp = NumSupp + 1
ListeImgSup.Add Item:=ObjetClasse, key:=CStr(NumSupp)
Set ObjetClasse = Nothing
Set ListeImgSup.Item(NumSupp).ImageSupp_Prog > > UserForm1.Frame1.Controls.Add("Forms.Image.1", NomImgSup)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeImgSup.Item(NumSupp).ImageSupp_Prog
.BorderStyle = fmBorderStyleNone
.Top = Placement + 1.5
.Left = PointAppui
.Width = (LargeurImage * FacteurAjust) / 4
.Height = HauteurImage - 3
.BackColor = vbRed
End With
'Labels noms de départements
NomLabel = "Lbl" & Str(NumLabel) '& Tableau(i)
NumLabel = NumLabel + 1
ListeLabels.Add Item:=ObjetClasse, key:=CStr(NumLabel)
Set ObjetClasse = Nothing
Set ListeLabels.Item(NumLabel).Label_Prog > > UserForm1.Frame1.Controls.Add("Forms.label.1", NomLabel)
Placement = Origine - Espace + (i - 1) * (HauteurImage + Espace)
With ListeLabels.Item(NumLabel).Label_Prog
.BorderStyle = fmBorderStyleNone
.BackStyle = fmBackStyleTransparent
.Caption = NomLabel
.WordWrap = False
.Top = Placement
.Left = 2
.Width = imgGauche.Width
.Height = HauteurImage + 5
.Font.Size = 7
.Font.Bold = True
End With
Next i
-----------------------------------------------------
Et c'est dans le module de classe que l'erreur survient.
-----------------------------------------------------
Private Sub ImageRég_Prog_MouseMove(ByVal Button As Integer, ByVal Shift
AsInteger, ByVal X As Single, ByVal Y As Single)
ImageRég_Prog.MousePointer = fmMousePointerSizeWE
If Button = 1 Then
If Pressé Then
If X > Position Then
ImageRég_Prog.Move Left:=(ImageRég_Prog.Left + (X -
Position))
ImageSupp_Prog.Left = ImageRég_Prog.Left '< Erreur:
Variable objet ou variable de bloc With non définie.
Else
ImageRég_Prog.Move Left:=(ImageRég_Prog.Left - (Position -
X))
ImageSupp_Prog.Left = ImageRég_Prog.Left '< Erreur:
Variable objet ou variable de bloc With non définie.
If ImageRég_Prog.Left < PointAppui Then
ImageRég_Prog.Left = PointAppui
End If
End If
End If
End If
End Sub
-----------------------------------------------------
Dis-moi que cela ne se produira pas avec ta technique...
Merci encore.
Pierre
-----------------------------------------------------
Bonsoir Michel,
Je viens d'essayer ta technique et je n'y arrive pas. Je ne sais pas si je
m'y prends correctement mais voici ce que j'ai fait:
Dans le UserForm, à l'ntérieur de la boucle
For i = 1 To NbreDeBarres...
j'ai répété les mêmes instructions que pour la première série de barres.
Les
nouvelles barres s'affichent mais je ne peux pas les survoler, le
programme
plante. En passant, j'utilise des images et non des labels; rien à voir
j'imagine ?
Voici le code que j'ai ajouté à la suite de la création des premières
barres
:
-------------------------------------------------------------------------
Set Ctl = Me.Frame1.Controls.Add("Forms.image.1", "Image" & i, True)
With Ctl
.BorderStyle = fmBorderStyleNone
.Top = Origine - Espace + (i - 1) * (HImage + Espace) + 1.5
.Left = Appui
.Width = LImage * FacteurAjust / 4 'Temporaire
.Height = HImage - 3
.BackColor = vbGreen
.MousePointer = fmMousePointerSizeWE
End With
ReDim Preserve ImgSupArray(i)
Set ImgSupArray(i).ImagesSup = Ctl
-------------------------------------------------------------------------
Bien sûr, j'avais pris soin de déclarer ImgSupArray comme l'autre.
Dans le module du UserForm :
Private ImgRégArray() As New Classe1
Private ImgSupArray() As New Classe1
Et dans le module de classe:
Public WithEvents ImagesRég As MSForms.Image
Public WithEvents ImagesSup As MSForms.Image
Mais le code qui permet de déplacer les premières barres ne me permet pas
de
faire référence à ImagesSup. ImagesSup.Left = ImagesRég.Left
< Variable objet ou variable de bloc With non définie. >
Je suis en panne et là je fais étalage de mon ignorance des modules de
classe.
Merci de ta patience.
Pierre
-------------------------------------------------------------------------
Bonsoir Michel,
Je viens d'essayer ta technique et je n'y arrive pas. Je ne sais pas si je
m'y prends correctement mais voici ce que j'ai fait:
Dans le UserForm, à l'ntérieur de la boucle
For i = 1 To NbreDeBarres...
j'ai répété les mêmes instructions que pour la première série de barres.
Les
nouvelles barres s'affichent mais je ne peux pas les survoler, le
programme
plante. En passant, j'utilise des images et non des labels; rien à voir
j'imagine ?
Voici le code que j'ai ajouté à la suite de la création des premières
barres
:
-------------------------------------------------------------------------
Set Ctl = Me.Frame1.Controls.Add("Forms.image.1", "Image" & i, True)
With Ctl
.BorderStyle = fmBorderStyleNone
.Top = Origine - Espace + (i - 1) * (HImage + Espace) + 1.5
.Left = Appui
.Width = LImage * FacteurAjust / 4 'Temporaire
.Height = HImage - 3
.BackColor = vbGreen
.MousePointer = fmMousePointerSizeWE
End With
ReDim Preserve ImgSupArray(i)
Set ImgSupArray(i).ImagesSup = Ctl
-------------------------------------------------------------------------
Bien sûr, j'avais pris soin de déclarer ImgSupArray comme l'autre.
Dans le module du UserForm :
Private ImgRégArray() As New Classe1
Private ImgSupArray() As New Classe1
Et dans le module de classe:
Public WithEvents ImagesRég As MSForms.Image
Public WithEvents ImagesSup As MSForms.Image
Mais le code qui permet de déplacer les premières barres ne me permet pas
de
faire référence à ImagesSup. ImagesSup.Left = ImagesRég.Left
< Variable objet ou variable de bloc With non définie. >
Je suis en panne et là je fais étalage de mon ignorance des modules de
classe.
Merci de ta patience.
Pierre
-------------------------------------------------------------------------
Bonsoir Michel,
Je viens d'essayer ta technique et je n'y arrive pas. Je ne sais pas si je
m'y prends correctement mais voici ce que j'ai fait:
Dans le UserForm, à l'ntérieur de la boucle
For i = 1 To NbreDeBarres...
j'ai répété les mêmes instructions que pour la première série de barres.
Les
nouvelles barres s'affichent mais je ne peux pas les survoler, le
programme
plante. En passant, j'utilise des images et non des labels; rien à voir
j'imagine ?
Voici le code que j'ai ajouté à la suite de la création des premières
barres
:
-------------------------------------------------------------------------
Set Ctl = Me.Frame1.Controls.Add("Forms.image.1", "Image" & i, True)
With Ctl
.BorderStyle = fmBorderStyleNone
.Top = Origine - Espace + (i - 1) * (HImage + Espace) + 1.5
.Left = Appui
.Width = LImage * FacteurAjust / 4 'Temporaire
.Height = HImage - 3
.BackColor = vbGreen
.MousePointer = fmMousePointerSizeWE
End With
ReDim Preserve ImgSupArray(i)
Set ImgSupArray(i).ImagesSup = Ctl
-------------------------------------------------------------------------
Bien sûr, j'avais pris soin de déclarer ImgSupArray comme l'autre.
Dans le module du UserForm :
Private ImgRégArray() As New Classe1
Private ImgSupArray() As New Classe1
Et dans le module de classe:
Public WithEvents ImagesRég As MSForms.Image
Public WithEvents ImagesSup As MSForms.Image
Mais le code qui permet de déplacer les premières barres ne me permet pas
de
faire référence à ImagesSup. ImagesSup.Left = ImagesRég.Left
< Variable objet ou variable de bloc With non définie. >
Je suis en panne et là je fais étalage de mon ignorance des modules de
classe.
Merci de ta patience.
Pierre
-------------------------------------------------------------------------
