Boton o formulario flotante visible siempre en página de excel.
Publicado por jose (8 intervenciones) el 24/05/2020 10:55:28
Buenos días,
En una página de excel tengo 4 botones que se coloca en la columna A y a un número de filas inferior a la celda activa.
Pero esto falla cuando se filtra la tabla, los diferentes botones se superponen. Lo que me gustaría conseguir es un formulario que contiene todos los botones, queden fijados en la parte inferroir de la pantalla del excel y siempre visible cuando mueva la página.
Tengo el siguiente código que ví en una página, estuve probando pero no funciona
Código que coloco en el worksheet
Codigo en formulario.
Gracias de antemano,
En una página de excel tengo 4 botones que se coloca en la columna A y a un número de filas inferior a la celda activa.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Desplazar botonesDim fila, columna As Variantfila = Target.Row
columna = Target.Column
With ActiveSheet.Shapes("BtNewSR")
'.Left = Cells(fila, columna + 2).Left.Top = Cells(fila + 3, columna).Top
End With
End Sub
Pero esto falla cuando se filtra la tabla, los diferentes botones se superponen. Lo que me gustaría conseguir es un formulario que contiene todos los botones, queden fijados en la parte inferroir de la pantalla del excel y siempre visible cuando mueva la página.
Tengo el siguiente código que ví en una página, estuve probando pero no funciona
Código que coloco en el worksheet
1
2
3
4
5
6
7
Private Sub BtsSheet_frm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Single)
If Button = 1 Then Formx = X: FormY = Y
End Sub
Private Sub BtsSheet_frm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Single)
If Button = 1 Then Me.Left (X - Formx): Me.Top = Me.Top + (Y - FormY)
End Sub
Codigo en formulario.
1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub BtsSheet_frm_Initialize()
Dim sql As sting, I As LongApplication.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
EliminarTitulo Me.CaptionWith BtsSheet_frm
.Height = 46
.Top = 300
.Left = 80
.Width = 90
End With
Gracias de antemano,
Valora esta pregunta
0
