Jump to content
Sign in to follow this  
Gerardo Arevalo

Resaltar shape al pasar mouse

Recommended Posts

Tengo un codigo, pero creo que no va por ahi

Sub seleccionaImagen()
Dim Imagen As Shape
For Each Imagen In ActiveSheet.Shapes
ConBorde Imagen

Next Imagen
End Sub


Private Sub ConBorde(Etiqueta)
Imagen.BorderStyle = fmBorderStyleNone

Etiqueta.BorderStyle = fmBorderStyleSingle
End Sub
[/CODE]

Share this post


Link to post
Share on other sites

.

De forma estandar no viene el evento MouseMove en una hoja Excel, ni para un rango, ni para un objeto incrustado (Shape, OleObject, ActiveX,....).

No obstante he encontrado un archivo .Dll que contiene una clase que tiene dichos eventos, se trata del archivo WorksheetMouseMove.dll.

En el adjunto encontrarás el archivo .Dll y un ejemplo de su utilización.

Pasos a seguir:

  • Copiar el archivo WorksheetMouseMove.dll a tu directorio \windows\system (o system32)
  • Abre el archivo Shape events.xls
  • Ves al proyecto VBA\Referencias, añade el archivo WorksheetMouseMove.dll y selecciona la referencia WorksheetMouseMove

Si has seguido los pasos correctamente, vuelve a la hoja y pulsa Ctrl+a y se activarán los eventos adicionales.

Al pasar el mouse por encima de cualquier objeto este será remarcado con un marco de color rojo adaptado a su tamaño.

Puedes cambiar el marco como te parezca, eso si, debe llamarse "MARCO".

Pulsa Ctrl+d para desactivar los eventos y ocultar el marco.

En el archivo encontrarás una imagen con las referencias del proyecto y otra con los eventos disponible, en nuestro caso solo utilizamos el evento Shape_Enter.

.

WorksheetMouseEvents.zip

Share this post


Link to post
Share on other sites

Me sale un mensaje: "No tienes la liscencia para usar el evento en este entorno"

luego ya no me salia ni el mensaje . copie el DLL y la opcion staba activada.

Tengo Mucha curiosidad por el tema

PD: perdon por entrometerme

Saludos...!

Share this post


Link to post
Share on other sites

-yo tengo w7 a 64 bits y realize los siguiente:

cd C:\Windows\SysWOW64 (enter)

regsvr32 C:\Windows\SysWOW64\libreria.ocx (enter)

Me salio el siguente error...

Y al correo la macro.

Me aparece este otro error:

No se a que se deba, me pueden ayudar por favor.

post-122545-145877010604_thumb.png

post-122545-145877010605_thumb.png

Share this post


Link to post
Share on other sites

Perdon por precipitar mis respuestas, logre instalar la libreria ya sin ningun error, pero al momento de correr el archivo con los comando que me indicas, no pasa nada, me meto al codigo para correrlo paso por paso, pero asi no pasa nada, si paso el mouse no funciona, que podra ser? Decidi agregar un CommandButton y sorpresa solo en esa figura aplica la macro.. pero en los shape no... :( :(

Share this post


Link to post
Share on other sites

Gerardo:

Lo siento pero yo tengo xp a 32 bits.

Intuyo que, dado que el archivo .dll fue creado en un SO de 32 bits, es muy posible que no funcione correctamente.

De todas maneras sube el archivo en el que has conseguido que no te de error y te comento como me funciona a mi.

=======================================================

Riverts

Lo siento, pero a ti no se que decirte. Hace mucho tiempo, quizás 3 años, que tengo este archivo instalado y no recuerdo haber tenido ningún problema con él.

========================================================

Os dejo el archivo original.

.

WorksheetMouseEvents.xls

Share this post


Link to post
Share on other sites

che acá te anexo el archivo que agregando los CommandButtom me funciona bien (a excepcion de los shapes que no pasa nada). El archivo que vos me mandas, cada que paso el mouse por una celda se ilumina de color azul y la info de los textbox va cambiando, no se si a vos le funcione igual :rolleyes::mad::P

Gracias por tu gran ayuda.

Shape events.xls

Share this post


Link to post
Share on other sites

Lo siento amigo, pero tu archivo me funciona sin problemas.

Abro el archivo, pulso Ctrl+a, paso el mouse por encima de los objetos y quedan remarcados en rojo.

Voy a prepararte una alternativa.

Share this post


Link to post
Share on other sites
Lo siento amigo, pero tu archivo me funciona sin problemas.

Abro el archivo, pulso Ctrl+a, paso el mouse por encima de los objetos y quedan remarcados en rojo.

Voy a prepararte una alternativa.

Gracias che, te reagradesco el esfuerzo que haces por ayudarme. Tal vez sea por el sistema operativo, aunque en el manual que lei, al dar de alta la liberia .dll que es de 32bits, aunque yo tengo mi SO a 64bits, se convierte y quedaria como esta de 32bits..:mad: quizas solo tengo re mala suerte :mad::P

Share this post


Link to post
Share on other sites

Pasa el mouse por encima del mapa del archivo adjunto.

El mapa está como imagen en un control ActiveX, el recuadro es un cuadro(Shape) transparente.

Las celdas con la cabecera en amarillo corresponden a los intervalos de actuación y dimensiones del cuadro de resalte.

Una vez afinados los parámetros, pueden ocultarse.

Ya comentarás si la solución te vale.

https://dl.dropboxusercontent.com/u/241435/Mapa.xlsm

.

Share this post


Link to post
Share on other sites

Macro Antonio, de seguro haz de estar mas que harto de que no me resulte y te siga molestando con mis tonterias. :(

Pero probe la macro y únicamente al seleccionar una ciudad, se pone la informa en el recuadro amarillo, mas no se resalta nada.. En la ciudad de tarragona, solo pone una linea fuera del cuadrado..

post-122545-145877010612_thumb.png

post-122545-145877010614_thumb.png

Share this post


Link to post
Share on other sites

Algo pasa con tus Shapes, e intuyo que debe tener algo que ver con la propiedad .Visible = True.

En una hoja nuevo dibuja un Shape cualquiera y ejecuta la siguiente macro varias veces, el Shape debe ocultarse y mostrarse alternativamente.

Sub MostrarOcultarÚltimoShape()
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Visible = _
Not ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Visible
End Sub[/CODE]

Si funciona, prueba poniendole un nombre al Sahape, por ejemplo "PEPE", y repite la operación con esta otra macro.

Sub MostrarOcultarÚltimoShape()

ActiveSheet.Shapes("PEPE").Visible = Not ActiveSheet.Shapes("PEPE").Visible

End Sub

Te dejo una imagen de como me sale a mi en el archivo que subí.

post-46507-145877010616_thumb.png

post-46507-145877010618_thumb.png

post-46507-14587701062_thumb.png

post-46507-145877010621_thumb.png

Share this post


Link to post
Share on other sites

Es muy extraño lo que esta pasando con los archivos que me mandas.

En cuanto a las instrucciones giradas, te comento que si funciona, si el shape esta visible se desaparece, vuelvo a correr la macro y aparece.. asi sucesivamente...

Nombre mi shape como PEPE, GERARDO, etc.. y sigue funcionando el codigo... :( A mi no me muestra asi la informacion en un recuadro...

Share this post


Link to post
Share on other sites

Hola, Macro Antonio; tienes razon si funciona solo que en el archivo "MAPA" ese recuadro lila que a ti te resalta, a mi tambien solo que por debajo de la imagen del "Mapa"

y en tu "Archivo Original" ps funciona todo menos las letras del "wordart" y las "Formas" q insertastes, el resto como el commandbutton y el textbox si funcionan

Saludos..!

post-138159-145877010625_thumb.jpg

Share this post


Link to post
Share on other sites

Gerardo, yo no se que más decirte, si se me ocurre algo nuevo te aviso.

Riverts, si mueves el mapa de sitio debes cambiar las columnas LEFT y TOP de la columna ETIQUETA.

Share this post


Link to post
Share on other sites

No se si me explique bien, el restalte de color lila en el archivo de mapa, gerardo y yo no lo visualizamos porque el restalte aparece por debajo del mapa y no por ensima. es decir, que si funciona el resalte al pasar el cursor solo que el mapa lo cubre .

Nota por eso movi el mapa, a ti te sale el resalte por ensima del mapa a nosotros por debajo de el.

Saludos..!

Share this post


Link to post
Share on other sites

Creo que ahora puede ser.

Sustituir la macro por:

Private Sub Mapa_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
ETQ.Caption = ""
ActiveSheet.Shapes("MARCO").Visible = False
For i = 8 To 11
If X > Range("G" & i) And X < Range("H" & i) And _
Y > Range("I" & i) And Y < Range("J" & i) Then
ActiveSheet.Shapes("MARCO").Visible = True
ActiveSheet.Shapes("MARCO").Select
With Selection
.ShapeRange.ZOrder msoBringToFront '<============== AÑADIDO
.Left = Range("K" & i): .Top = Range("L" & i)
.Height = Range("M" & i): .Width = Range("N" & i)
End With
ETQ.Caption = Range("F" & i) & Chr(10) & "POB: " & _
Range("O" & i) & Chr(10) & "PIB: " & Range("P" & i)
ActiveCell.Select
Exit Sub
End If
Next
ActiveCell.Select
End Sub
[/CODE]

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.
Sign in to follow this  

×
×
  • Create New...

Important Information

Privacy Policy