Scrollbar

Hola a todos: Me pregunto si alguien me podria decir como puedo hacer funcionar un scrollbar correctamente dentro de un formulario en un macro de excel...
Porfavor diganme, ustedes que son unos expertos en el uso de esas aplicaciones se los agradesere basante..GRACIAS..
Mi correo es [email protected]  para lo que se ofresca 

1 Respuesta

Respuesta
1
'Necesitas una forma, y un checkBox (CheckBox1)
Option Explicit
' Estructura para la función del api GetVersionEx
      Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128
      End Type
      ' Declaraciones Api
    Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
    Private Declare Function SetKeyboardState Lib "user32" (lppbKeyState As Byte) As Long
    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long
    Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" ( _
        lpVersionInformation As OSVERSIONINFO) As Long
    Private Declare Sub keybd_event Lib "user32" ( _
        ByVal bVk As Byte, _
        ByVal bScan As Byte, _
        ByVal dwFlags As Long, _
        ByVal dwExtraInfo As Long)
    ' Declaración de constantes
    Private Const KEYEVENTF_EXTENDEDKEY = &H1
    Private Const KEYEVENTF_KEYUP = &H2
    Private Const VER_PLATFORM_WIN32_NT = 2
    Private Const VER_PLATFORM_WIN32_WINDOWS = 1
 Private Sub Form_Load()
Dim NumLock As Long
Dim CapsLock As Long
Dim ScrollLock As Long
    ' devuelve el estado de las teclas
    NumLock = GetKeyState(vbKeyNumlock)
    CapsLock = GetKeyState(vbKeyCapital)
    ScrollLock = GetKeyState(vbKeyScrollLock)
    ' Establece los ckeckbox para mostrar el estado
    bNoClick = True
    If NumLock And 1 Then Check1(0).Value = 1
    bNoClick = False
    bNoClick = True
    If CapsLock And 1 Then Check1(1).Value = 1
    bNoClick = False
    bNoClick = True
    If ScrollLock And 1 Then Check1(2).Value = 1
    bNoClick = False
    Check1(0).Caption = "NumLock"
    Check1(1).Caption = "CapsLock"
    Check1(2).Caption = "ScrollLock"
End Sub
Private Sub CheckBox1_Click()
Dim OINFO As OSVERSIONINFO
Dim ret As Boolean
Dim keys(0 To 255) As Byte
    If bNoClick Then Exit Sub
    OINFO.dwOSVersionInfoSize = Len(OINFO)
    GetVersionEx OINFO
    GetKeyboardState keys(0)
    '''''''''''''''''''''''''''''''
         ret = keys(vbKeyCapital)
             ' Windows 95 / Windows 98
            If OINFO.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
                keys(vbKeyCapital) = Abs(Not ret)
                SetKeyboardState keys(0)
            ' Windows NT
            ElseIf OINFO.dwPlatformId = VER_PLATFORM_WIN32_NT Then
                keybd_event vbKeyCapital, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
                keybd_event vbKeyCapital, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
            End If
        ' Tecla ScrollLock
        '''''''''''''''''''''''''''''''
End Sub
'* MODIFICADO DE http://www.recursosvisualbasic.com.ar/htm/listado-api/223-capslock-numlock-scroll.htm

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas