listbox y label

y otra que se me ha pasado:

si haces la ultima modificacion puedes eliminar el uso del evento Click (y si no la haces tambien con solo incluir la
macro para el color en el mouseUp)

disculpas por los despistes

un saludo
Ivan

"Ivan" escribió en el mensaje news:%

hola de nuevo, Daniel

si quieres asegurarte de que te cambien el color le des con el boton que le des y como le des, cambia en el mouse Up y
el procedimiento Nombre_Y_Macro_1 por estos

'--
Private Sub Label4_MouseUp(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Color_Label Label4
If Button = 2 Then Application.Run "MiMacro_2"
End Sub
'--
Sub Nombre_Y_Macro_1(lbl As MSForms.Label)
TextBox1 = lbl.Caption: TextBox2 = lbl.Name
Color_Label lbl: Application.Run "MiMacro_1"
End Sub
'--


el resto puede quedarse igual

un saludo
Ivan

Hola Ivan
Muchas gracias por responer
No hay ningun metodo o macro para no tener que pegar en todos por que es que
son muchos los label que uso
mas de 80

Private Sub Label4_Click()
Color_Label Label4
End Sub
Private Sub Label4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Nombre_Y_Macro_1 Label4
End Sub

un saludo y muchas gracias
daniel

"Ivan" escribió en el mensaje
news:%23e$

y otra que se me ha pasado:

si haces la ultima modificacion puedes eliminar el uso del evento Click (y
si no la haces tambien con solo incluir la macro para el color en el
mouseUp)

disculpas por los despistes

un saludo
Ivan

"Ivan" escribió en el mensaje
news:%

hola de nuevo, Daniel

si quieres asegurarte de que te cambien el color le des con el boton que
le des y como le des, cambia en el mouse Up y el procedimiento
Nombre_Y_Macro_1 por estos

'--
Private Sub Label4_MouseUp(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Color_Label Label4
If Button = 2 Then Application.Run "MiMacro_2"
End Sub
'--
Sub Nombre_Y_Macro_1(lbl As MSForms.Label)
TextBox1 = lbl.Caption: TextBox2 = lbl.Name
Color_Label lbl: Application.Run "MiMacro_1"
End Sub
'--


el resto puede quedarse igual

un saludo
Ivan

hola Daniel,

No hay ningun metodo o macro para no tener que pegar en todos por que es que son muchos los label que uso mas de 80

aunque no tengo mucha idea (de hecho no me hagas mucho caso) creo que en caso de poderse la unica manera seria
'monitorizando' la aplicacion cada muy poquitos segundos, es decir comproband el ActiveControl cada muy, muy poquito con
algo tipo AplicationOntaime (aun asi creo que conseguir diferenciar los eventos para realizar cada una de las acciones
segun el caso [¿quizas con Called?] resultaria sumamente complicado)

como te digo no me hagas mucho caso (espero que si alguien sabe como te lo indique) pero me temo, que, como dice (+/-)
un experto de este foro, 'te saldria mas caro el caldo que las gallinas'. Aunque de esta forma tengas que rellenar todos
los label (podrias hacerlo por ej. con una macro si te quieres ahorrar el trabajo), solo lo harias una vez. De la otra
forma siempre tendrias detras una macro funcionando.

otra opcion es crear el codigo en tiempo de ejecucion (pero en mi opinion seria algo parecido en cuanto a la 'sopa' se
refiere)

ademas tal y como te he planteado las macros creo que te resultaria muy facil copiarlas

con bules podrias hacer algo asi=>

en un libro con una hoja en blanco podrias ejecutar algo como=>

sub Codigo()
dim n as integer,f as integer
f=1
for n = 1 to 80 ' o el nº total de labels (deben ir consecutivos numerados)
cells(f,1).value="Private Sub Label" & n & "_Click()": f=f+1
cells(f,1).value="Color_Label Label" & n: f=f+1
cells(f,1).value="End Sub": f=f+1
cells(f,1).value="Private Sub Label" & n & _
"_DblClick(ByVal Cancel As MSForms.ReturnBoolean)": f=f+1
cells(f,1).value="Nombre_Y_Macro_1 Label" & n: f=f+1
cells(f,1).value="End Sub": f=f+1
next
end sub

y luego copiar de la celda a1 hasta la ultima celda con datos de a y pegarlo en el modulo (tambien puedes pegarlo en el
modulo directamente pero creo que es mas lioso de explicar <si lo prefieres asi echa un ojo en la ayuda a los
objetos/propiedades y/o metodos tipo VBAProject, vbcomponents, codemodule, insertlines, etc.. >

un saludo
Ivan

hola de nuevo, Daniel

lo que si seria posible [creo] seria limitarlo todo a un solo procedimiento en el keyUp, capturando un tiempo estimado
entre click y click para simular el caso del doble click. Asi te limitarias a tres lineas por label que ademas creo que
podrias poner en una sola usando los 2 puntos + espacio (unido al truco de la hoja podrias tenerlo en ¿3,4,5
...segundos?)

se me acaba de ocurrir y no creo que fuese complicado. Si no te dan una solucion mejor. En cuanto acabe una cosa que
esoy intentando intentamos verlo

un saludo
Ivan

PD: en el codigo 'Codigo' que te ponia en el ultimo mensaje inclui el evento click porque estaba en tu respuesta y no
me fije, pero de hacerlo tal cual yo dejaria solo el DoubleClick y el MouseUp como te indicaba en el anterior mensaje

y hola de nuevo, Daniel ( como soy un pesado al final me he liado y esto es lo que me ha salido, por si quieres
probarlo)

en el modulo del formulario borra todos los eventos de los label (o al menos los del KeyUp) y pega esto=>

'--modulo del formulario
'
Sub Color_Label_Y_Nombre(lbl As MSForms.Label)
Dim n As Byte
For n = 1 To 4
With Controls("Label" & n)
If .Name <> lbl.Name Then .BackColor = vbCyan Else .BackColor = vbBlue
End With
Next
TextBox1 = lbl.Caption: TextBox2 = lbl.Name
End Sub
'-
Sub Combinada(lbl As MSForms.Label, ByVal Button As Integer)
Dim n As Integer
Color_Label_Y_Nombre lbl
Select Case Button
Case 1
If (Timer * 1000) - tiempo < 500 Then _
Application.Run "MiMacro_1": tiempo = Timer * 1000
Case 2: Application.Run "MiMacro_2": tiempo = Timer * 1000
End Select
If tiempo = 0 Or tiempo > 500 Then tiempo = Timer * 1000
End Sub
'
'--!!! OJO ¡¡¡ si tienes algo en el initialice simplemente incluye en el la instrucion que va dentro
'
Private Sub UserForm_Initialize()
tiempo = Timer * 1000
End Sub
'--

en un modulo NORMAL pega esto otro

'-en un modulo NORMAL--
'
Public Sub MiMacro_1()
MsgBox "Ejecutando macro 1"
End Sub
'
Public Sub MiMacro_2()
MsgBox "Ejecutando macro 2"
End Sub
'este codigo ejecutalo 1 sola vez con F5 desde el mismo editor (despues puedes borrarlo o quitarlo).
'Una vez ejecutado echale un ojo al modulo del formulario y pruebalo
Sub Codigo()
Dim n As Integer, f As Integer, mCode As CodeModule
' si tu formulario no se llama userform1 cambialo en la siguiente instruccion
Set mCode = ThisWorkbook.VBProject.VBComponents("UserForm1").CodeModule
With mCode
f = .CountOfLines + 1
For n = 1 To 80 ' o el nº total de labels (deben ir consecutivos numerados)
' ojo cada instruccion debe ir en una sola linea (esta 1ª se rompera casi seguro en el foro OJO)
.InsertLines f, "Private Sub Label" & n & "_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As
Single, ByVal Y As Single)": f = f + 1
.InsertLines f, " Combinada Label" & n: f = f + 1
.InsertLines f, "End Sub": f = f + 1
Next
End With
Set mCode = Nothing
End Sub
'--

presta atencion a los comentarios sobre todo de este ultimo codigo

si lo pruebas si quieres comentas

un saludo
Ivan