** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Otros de Microsoft: Windows y Office > Excel
  Mensajes nuevos Mensajes nuevos RSS - posición UserForm
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoposición UserForm

 Responder Responder
Autor
Mensaje
ximo Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 03/Marzo/2006
Localización: España
Estado: Sin conexión
Puntos: 2085
Enlace directo a este mensaje Tema: posición UserForm
    Enviado: 29/Mayo/2020 a las 18:20
Hola,
Sería muy complicado que al abrir un userform se posicionase dos celdas por arriba de la activa, actualmente se me abre en el centro de la hoja que no es que este mal pero por aprender algo más y quizás quede mejor, para la celda que lo requiero es cualquier celda vacía de la columna "B" entonces me abre el formulario para introducir el nombre del proveedor y su nif, tal y como lo quiero no tienes que desviar la vista al centro ya que estaría justo encima +-.

Esto es lo que tengo dentro del userform
Option Explicit

'declaraciones de las api de windows
Const GWL_STYLE = -16
Const WS_CAPTION = &HC00000
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'llamadas a las apis para eliminar barra de título del formulario
Private Sub UserForm_Initialize()
    Dim lngWindow As Long, lFrmHdl As Long
    lFrmHdl = FindWindowA(vbNullString, Me.Caption)
    lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
    lngWindow = lngWindow And (Not WS_CAPTION)
    Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
    Call DrawMenuBar(lFrmHdl)
End Sub

Private Sub CommandButton1_Click()
'Escribe el texto en la celda activa.
 ActiveCell.Value = Me.ComboBox1.Value
'Nos desplazamos dos celdas a la derecha
'de la celda activa
 ActiveCell.Offset(0, 2).Select
'Cierra el formulario
Unload Me
End Sub


Private Sub CommandButton2_Click()
'cierra el formulario 
Unload Me
End Sub

Private Sub UserForm_Activate()
'Cargamos el combo con los datos de la tabla
ComboBox1.List() = Hoja9.Range("A2:A" & Hoja9.Range("A" & Rows.Count).End(xlUp).Row).Value
ComboBox1.SetFocus
End Sub




Saludos, ximo

La incansable busqueda de información abre nuestras mentes

Saludos desde Burriana
Arriba
ximo Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 03/Marzo/2006
Localización: España
Estado: Sin conexión
Puntos: 2085
Enlace directo a este mensaje Enviado: 30/Mayo/2020 a las 18:46
Hola,

Pues estoy cansado de búsquedas y pruebas, al final no es lo que busco pero se acerca.

    'posicionar formulario
    Me.StartUpPosition = 0
    Me.Left = 80
    Me.Top = 200
Entiendo que StartUpPosition = 0 es manual
Left con 80 va bien ya que cubre justo la columna B
Top es arriba y se abre el formulario justo debajo de la fila 6 con top=200.
No sé como indicar el Top para que se abra encima de la celda activa, no me vale ActiveCell ni ActiveCell.Row.



Saludos, ximo
La incansable busqueda de información abre nuestras mentes

Saludos desde Burriana
Arriba
prga Ver desplegable
Moderador
Moderador


Unido: 16/Noviembre/2004
Localización: España
Estado: Sin conexión
Puntos: 3523
Enlace directo a este mensaje Enviado: 30/Mayo/2020 a las 19:57
Hola.
Yo de excel lo justo de lo justo, así es que no se si servirá el siguiente código de ejemplo:


Dim fila As Long
Dim columna As Long
Dim micelda As Range
MsgBox (ActiveCell.Left)
MsgBox (ActiveCell.Top)
fila = ActiveCell.Row
columna = ActiveCell.Column
Set micelda = Cells(fila - 2, columna)
MsgBox (micelda.Left)
MsgBox (micelda.Top)

que serían las "coordenadas" de la celda 2  arriba de la activa
Espero que al menos aporte ideas.
Ya comentas
Un saludo a todos

Arriba
ximo Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 03/Marzo/2006
Localización: España
Estado: Sin conexión
Puntos: 2085
Enlace directo a este mensaje Enviado: 31/Mayo/2020 a las 12:01
Hola,
Por fin se consiguió lo que pretendía.
Prga: el código tal cual tampoco me funcionaba, pero tratando de entender lo que hacía y lo que yo pretendía y jugando con los valores se me ha ocurrido sumar al resultado lo justo para que funcione, ya se el formulario siempre se abría 6 filas por encima de la celda activa, he comenzado restando y al comprobar el error he ido sumando hasta dejarlo feten justo encima de la celda activa.
La cosa ha quedado de la siguiente forma.

Dim fila As Long
Dim columna As Long
Dim micelda As Range
'igualamos con el número de fila
fila = ActiveCell.Row
'igualamos con el número de columna
columna = ActiveCell.Column
'obtenemos coordenadas
Set micelda = Cells(fila - 2, columna)
'posición en manual
Me.StartUpPosition = 0
'izquierda
Me.Left = 80
'arriba hay que ir sumando hasta ajustar al sitio deseado
Me.Top = (micelda.Top + 100)

Muchas gracias, si queréis añadir algún comentario o solución perfecto si no se puede cerrar.



Saludos, ximo 
La incansable busqueda de información abre nuestras mentes

Saludos desde Burriana
Arriba
ximo Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 03/Marzo/2006
Localización: España
Estado: Sin conexión
Puntos: 2085
Enlace directo a este mensaje Enviado: 31/Mayo/2020 a las 12:25
Hola,
Mi gozo en un pozo, solo funciona si no se hace escroll en la página, en mi caso funciona hasta la fila 33 que es la última que se ve, si bajo a las siguientes filas se abre el formulario pero no sé donde ya que no lo veo, estamos igual o peor, se tendría que poder indicarle que se abra encima de la celda activa para ir bien.


Saludos, ximo
La incansable busqueda de información abre nuestras mentes

Saludos desde Burriana
Arriba
AnSanVal Ver desplegable
Administrador
Administrador
Avatar

Unido: 16/Marzo/2005
Localización: España
Estado: Sin conexión
Puntos: 5970
Enlace directo a este mensaje Enviado: 31/Mayo/2020 a las 23:41
De momento tengo "liada" con un mueble para la oficina de mi hijo Wacko, pero (no he leído los códigos aportados)... 

...la celda activa tiene la propiedad TOP y el formulario también: miFormulario.Top = ActiveCell.top. pero ¡Ojo! la celda activa puede estar una pantalla (o varias) hacia arriba o hacia abajo o hacia la derecha, o … , vamos, si la celda activa no está visible el formulario tampoco lo estaría.


Saludos desde Tenerife.
Arriba
ximo Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 03/Marzo/2006
Localización: España
Estado: Sin conexión
Puntos: 2085
Enlace directo a este mensaje Enviado: 02/Junio/2020 a las 17:30
Hola Antonio,

Tampoco funciona, en cuanto paso de la fila 40 desaparece el formulario.
Lo único que funciona a medias es esto:
me.startupposition=0
.left=80
.top=300' se queda siempre en la mitad de la columna aunque me desplace a la fila 2000, como si el formulario estuviese centrado pero sobre la columna B.
Es lo máximo que consigo llegar con mis conocimiento y búsquedas en san google.

Saludos, ximo
La incansable busqueda de información abre nuestras mentes

Saludos desde Burriana
Arriba
lbauluz Ver desplegable
Administrador
Administrador
Avatar

Unido: 29/Marzo/2005
Localización: La Gloria
Estado: Sin conexión
Puntos: 3849
Enlace directo a este mensaje Enviado: 02/Junio/2020 a las 19:42
Hola Ximo

Mi duda es:
Quieres que el form se abra dos celdas por encima de la celda seleccionada.
Quieres que esté visible.

¿donde quieres que aparezca si la celda seleccionada está fuera de visión?, teniendo en cuenta que puede estar fuera de visión tanto por arriba como por abajo como por la izquierda o la derecha.

Yo supongo, pero es imaginación mía, que quieres que si la celda está visible, Y HAY ESPACIO suficiente, aparezca dos celdas por encima, y que encaso contrario, aparezca en la zona superior y se mantenga ahí.


Un saludo.

Luis
El Búho es un pajarraco
Arriba
ximo Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 03/Marzo/2006
Localización: España
Estado: Sin conexión
Puntos: 2085
Enlace directo a este mensaje Enviado: 02/Junio/2020 a las 19:59
Hola,

Evidentemente la celda siempre esta visible como si no vamos a rellenarla, de todas formas lo tengo solucionado, a falta de más ideas, quizás más fácil, no sé.

'Esto en un módulo

Option Explicit

Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Public Type pointcoordinatestype
    Left As Double
    Top As Double
    Right As Double
    Bottom As Double
End Type
Private pixelsperinchx As Long, pixelsperinchy As Long, pointsperinch As Long, zoomratio As Double
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
#Else
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
#End If

Private Sub ConvertUnits()
  Dim hdc As LongPtr
    hdc = GetDC(0)
    pixelsperinchx = GetDeviceCaps(hdc, LOGPIXELSX) ' Usually 96
    pixelsperinchy = GetDeviceCaps(hdc, LOGPIXELSY) ' Usually 96
    ReleaseDC 0, hdc
    pointsperinch = Application.InchesToPoints(1)   ' Usually 72
    zoomratio = ActiveWindow.Zoom / 100
End Sub

Private Function PixelsToPointsX(ByVal pixels As Long) As Double
    PixelsToPointsX = pixels / pixelsperinchx * pointsperinch
End Function

Private Function PixelsToPointsY(ByVal pixels As Long) As Double
    PixelsToPointsY = pixels / pixelsperinchy * pointsperinch
End Function

Private Function PointsToPixelsX(ByVal points As Double) As Long
    PointsToPixelsX = points / pointsperinch * pixelsperinchx
End Function

Private Function PointsToPixelsY(ByVal points As Double) As Long
    PointsToPixelsY = points / pointsperinch * pixelsperinchy
End Function

Public Sub GetPointCoordinates(ByVal cellrange As Range, ByRef pointcoordinates As pointcoordinatestype)
  Dim i As Long
    ConvertUnits
    Set cellrange = cellrange.MergeArea
    For i = 1 To ActiveWindow.Panes.Count
        If Not Intersect(cellrange, ActiveWindow.Panes(i).VisibleRange) Is Nothing Then
            pointcoordinates.Left = PixelsToPointsX(ActiveWindow.Panes(i).PointsToScreenPixelsX(cellrange.Left))
            pointcoordinates.Top = PixelsToPointsY(ActiveWindow.Panes(i).PointsToScreenPixelsY(cellrange.Top))
            pointcoordinates.Right = pointcoordinates.Left + cellrange.Width * zoomratio
            pointcoordinates.Bottom = pointcoordinates.Top + cellrange.Height * zoomratio
            Exit Sub
        End If
    Next
End Sub

'Y esto en el formulario

Private Sub UserForm_Initialize()
    
  Dim pointcoordinates As pointcoordinatestype, horizontaloffsetinpoints As Double, verticaloffsetinpoints As Double
    With Me
        horizontaloffsetinpoints = (.Width - .InsideWidth) / 2
        verticaloffsetinpoints = 1
        Call GetPointCoordinates(ActiveCell, pointcoordinates)
        .StartUpPosition = 0
        .Top = pointcoordinates.Top - verticaloffsetinpoints
        .Left = pointcoordinates.Left - horizontaloffsetinpoints
    End With
End Sub


Saludos, ximo
La incansable busqueda de información abre nuestras mentes

Saludos desde Burriana
Arriba
lbauluz Ver desplegable
Administrador
Administrador
Avatar

Unido: 29/Marzo/2005
Localización: La Gloria
Estado: Sin conexión
Puntos: 3849
Enlace directo a este mensaje Enviado: 02/Junio/2020 a las 22:22
Por si te interesa, tengo una solución más sencilla, "de andar por casa".

Lo que hago es capturar la posición del cursor cuando editas una celda, así siempre voy a saber la posición en pantalla en pixels

Con esta posición, que es la misma de la celda, puedo posicionar el form.

Detalles a pulir

He puesto las posiciones con respecto a mi monitor, no me he molestado en buscar la forma de que se busque automáticamente y se coloque en cualquier monitor y cualquier resolución, por lo tanto o eso lo haces tú, o lo buscamos si te interesa, pero lo más normal es que trabajes siempre con el mismo monitor y resolución, por lo que solo necesitas "calibrarlo" una vez.

Yo al form le he llamado userf, deberás poner el nombre que tu uses.
Además he añadido un módulo donde pongo la captura del ratón y el evento en la hoja excel para saber que has seleccionado.

MÓDULO

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POSMOUSE) As Long

Public Type POSMOUSE
    x As Long
    y As Long
End Type

 
Public Function DameCoordCursor(ByRef x As Long, ByRef y As Long) As Integer
    Dim pos As POSMOUSE
    GetCursorPos pos
    x = pos.x
    y = pos.y
    DameCoordCursor = 0
End Function



HOJA EXCEL
Public Sub Worksheet_SelectionChange (ByVal Target As Range)
    Dim x As Long
    Dim y As Long
    Dim z As Integer
    
    z = DameCoordCursor(x, y)
    If (x < 807) Then ' 807 mes elancho que cuadra con mi monito y resolución
        userf.left = x ´userf es el nombre del form
    Else
        userf.left = 807
    End If
    If (y < 505) Then ' 505 es la altura que cuadra con mi monitor y resolución
        userf.top = y
    Else
        userf.top = 505
    End If
End Sub

NOTA: Acabo de darme cuenta, si no seleccionas con el ratón, esto no sirve.. ¡lo siento!

Un saludo.

Luis



Editado por lbauluz - 02/Junio/2020 a las 22:42
El Búho es un pajarraco
Arriba
ximo Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 03/Marzo/2006
Localización: España
Estado: Sin conexión
Puntos: 2085
Enlace directo a este mensaje Enviado: 04/Junio/2020 a las 18:52
Hola,

Luis, mo me resulto bién quizás no termine de ponerlo bien, de todas forma lo he resolucionado muuuuucho más sencillo.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim col As String
    col = Left(ActiveCell.Address(False, False), 1)
    If col = "B" Then
        UserForm1.Top = ActiveCell.Top - Range("A" & ActiveWindow.ScrollRow).Top + 125
        UserForm1.Left = ActiveCell.Left + 18
        UserForm1.Show
    End If

End Sub

Private Sub UserForm_Activate()

    Me.Top = ActiveCell.Top - Range("A" & ActiveWindow.ScrollRow).Top + 125
    Me.Left = ActiveCell.Left + 18

End Sub


Sin APIS ni na de na, solo ajustar top+x y left+x




Saludos, ximo
La incansable busqueda de información abre nuestras mentes

Saludos desde Burriana
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable