Kirjautuminen

Haku

Tehtävät

Kilpailu

Putka Open 2025
Kilpailu on päättynyt.

Keskustelu: Ohjelmointikysymykset: VBA: Combobox Vieritys ja tyhjentymis ongelma (MS excel vb)

Kaitzu [25.03.2009 10:03:37]

#

Moro!

Eli seuraavansorttisia ongelmia comboboxin virittelyssä:
Miten saisi hiiren vieritysrullan kohdennettua comboboxin listaan, kun lista avataan? Nyt hiiri rullaa vain excel taulukkoa comboboxin listan alla.
Comboboxissa on piitkä lista(useita sivuja) ja helpottaisi käyttöä, jos saisi hiirellä rullattua listaa eestaas.

Ja toinen vakavampi ongelma on comboboxin valinnan tyhjentyminen, kun tiedosto avataan.
Eli valitaan comboboxin listalta tuote-->valittu kohde ilmestyy comboboxiin ja lista poistuu näkyvistä, kaikki ok.
Sitten tallennetaan työkirja (Esim.Puppu.xls), edelleen kaikki ok. Suljetaan excel. Ja kun seuraavan kerran avataan puppu.xls niin viimeksi valittu comboboxin sisältö näkyy vilauksen verran ruudussa, jonka jälkeen comboboxin sisältö tyhjenee. (Pitää valita listalta uudestaan)

Koska kyseessä on lomake jonka tiedot pitäisi pystyä tallentamaan, tämä tyhjenemis ominaisuus vie pohjan koko hommalta.

-Kaitzu-

neau33 [25.03.2009 17:18:35]

#

Moro Kaitsu!

Käytä ListBox-kontrollia...

Kaitzu [26.03.2009 09:26:09]

#

Kiitos, mutta en löytänyt apua Listboxista. Hiirulainen ei rullaa siinäkään.

Comboboxi on käytössä, koska käyttäjän pitäisi pystyä kirjoittamaan listaan lisäyksiä.

En tiedä miten tässä pitäisi toimia, kun nyt comboboxi näyttää työkirjaa
avattaessa Linked cell sisällön tekstikentässä.

Comboboxissa on kolme saraketta, joista 2.sarake = teksti kenttä ja 3.sarake = numerosarake, jonka arvo näytetään valinnan jälkeen "linked cell" solussa.
Ensimmäistä comboboxin saraketta ei käytetä valinnan jälkeen mihinkään.
(column count= 3, bound column= 3, text column= 2, linked cell= joku solu)

Erilaisilla copypaste tyyppisillä ohjelmakäskyillä saan tiedot pysymään näkyvissä(ei kuitenkaan comboboxissa), mutta linked cell arvo vaan tulee jostain teksti kenttään comboboxiin.(Tallentamisen ja uudelleen avaamisen jälkeen siis)

Auttakee tietämätöntä.

-Kaitzu-

neau33 [26.03.2009 15:37:46]

#

Heippa taas kaitsu!

Tuolle vierittelylle en ole löytänyt vastausta, mutta sensijaan voisit testata oheista viritelmää...

'Taul1
Private Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)

Sub MainLoop()
  Do While Not ExitProg
    Sleep 100
    ComboBox1.DropDown
    If ComboBox1.ListCount = 0 Then
      Auto_Open
    End If
  DoEvents: Loop
End Sub
'Module1
Global IsExit As Boolean
Private cboList(9, 2) As Variant
Sub Auto_Open()

  IsExit = False: listFill
  Sheets(1).ComboBox1.List = cboList
  Sheets(1).Activate
  Sheets(1).ComboBox1.ListIndex = 0
  Sheets(1).MainLoop

End Sub

Sub listFill()
  For i = 0 To 9
    For j = 0 To 2
      Select Case j
        Case 0
         cboList(i, j) = ""
        Case 1
         cboList(i, j) = "Text " & CStr(i + 1)
        Case 2
         cboList(i, j) = (i + 1)
      End Select
    Next
  Next i
End Sub
'ThisWorkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
   IsExit = True
End Sub

Kaitzu [27.03.2009 09:03:26]

#

Moikka taas, kiitos ohjeesta Nea!
Testaan tuon antamasi ohjelmapätkänkin vertailun vuoksi ja opetusmielessä. =)

Ongelman ydin (mutu)löytyi comboboxin ominaisuuksista.

Kuten mainittu, niin comboboxin 3.sarake on numerosarake kahdella desimaalilla. Comboboxi ei hyväksy muita kuin kokonaislukuja, eli jos luku on 6,0 kaikki on ok mutta jos luku onkin 6,1, niin seuraavalla avauskerralla comboboxin sisältö (teksti) on 6,1. Kun tässäkohtaa ei tee muuta kuin tallentaa ja sulkee ohjelman, niin seuraavalla avauskerralla comboboxi on tyhjä.

Sama koskee numeroita, joiden lähde solulla on jokin muotoilu (esmes.Valuutta)-->comboboxi ei tykkää ja tyhjentää seuraavalla avauskerralla sisältönsä.

Lisäksi comboboxi tyhjenee, vaikka valinta olisikin kokonaisluku tai teksiä, jos bound column = 0.
Bound columniksi 1, niin johan valinta pysyy tallentamisen jälkeen (tämä ei päde edelleenkään desimaalilukuihin)

3.sarakkeen numerot muutin tulostettavaksi lomakkeelle seuraavalla lauseella:

ActiveSheet.Range("J16").FormulaR1C1 = ComboBox17.Column(2) 'Tulostaa 3.sarakkeen numerot soluun J16

Ja samalla poistin comboboxin

LinkedCell

arvon kokonaan ja muutin

BoundColumniksi

2.sarakkeen (tekstisarakkeen)

Nyt toimii niinkuin pitääkin.


Hiiri rulla ongelma on edelleen avoin.

-Kaitzu-

neau33 [28.03.2009 08:15:54]

#

Heippa taas Kaitsu!

tässä testijutskaan lisättynä - Excel ComboBox [taulussa] Mouse Wheel scroll...ei pelitä täysillä, mutta tutkitaan

'Module1
Option Explicit

Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Declare Function GetForegroundWindow Lib "user32" () As Long

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)

Declare Function SetWindowsHookEx Lib _
"user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _
ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal nCode As Long, ByVal Wparam As Long, Lparam As Any) As Long

Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long

Public Type POINTAPI
  X As Long
  Y As Long
End Type

Type MSLLHOOKSTRUCT
    pt As POINTAPI
    mouseData As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type

Global Const HC_ACTION = 0
Global Const WH_MOUSE_LL = 14
Global Const WM_LBUTTONDOWN = &H201
Global Const WM_MOUSEWHEEL = &H20A

Private hhkLowLevelMouse
Public udtlParamStuct As MSLLHOOKSTRUCT
Public intTopIndex As Integer
Global cboList() As Variant
Global DoExit As Boolean

Function GetHookStruct(ByVal Lparam As Long) As MSLLHOOKSTRUCT
   CopyMemory VarPtr(udtlParamStuct), Lparam, LenB(udtlParamStuct)
   GetHookStruct = udtlParamStuct
End Function

Function LowLevelMouseProc(ByVal nCode As Long, _
ByVal Wparam As Long, ByVal Lparam As Long) As Long

    On Error Resume Next
    If GetForegroundWindow <> FindWindow( _
    "XLMAIN", Application.Caption) Then
        Sheets("Sheet1").ComboBox1.TopLeftCell.Select
        UnHook_Mouse
        Exit Function
    End If
    If (nCode = HC_ACTION) Then
        If Wparam = WM_MOUSEWHEEL Then
            LowLevelMouseProc = True
            With Sheets("Sheet1").ComboBox1
                If GetHookStruct(Lparam).mouseData > 0 Then
                    .TopIndex = intTopIndex - 1
                    intTopIndex = .TopIndex
                Else
                    .TopIndex = intTopIndex + 1
                    intTopIndex = .TopIndex
                End If
           End With
        End If
        Exit Function

    End If
    LowLevelMouseProc = CallNextHookEx(0, nCode, Wparam, ByVal Lparam)

End Function

Sub Hook_Mouse()
   hhkLowLevelMouse = SetWindowsHookEx (WH_MOUSE_LL, _
   AddressOf LowLevelMouseProc, Application.Hinstance, 0)
End Sub

Sub UnHook_Mouse()
   If hhkLowLevelMouse <> 0 Then
      UnhookWindowsHookEx hhkLowLevelMouse
   End If
End Sub
Sub Auto_Open()
   ReDim cboList(9, 2)
   DoExit = False: listFill
   Sheets(1).Activate
   Sheets(1).ComboBox1.LinkedCell = "Q1"
   Sheets(1).ComboBox1.List = listFill
   Sheets(1).ComboBox1.ListIndex = 0
   Sheets(1).MainLoop
End Sub

Function listFill() As Variant
   Dim i As Integer, j As Integer
   For i = 0 To 9
     For j = 0 To 2
        Select Case j
           Case 0
             cboList(i, j) = ""
           Case 1
             cboList(i, j) = "Text " & CStr(i + 1)
           Case 2
             cboList(i, j) = (i + 1)
        End Select
     Next
   Next i
   listFill = cboList
End Function
'Taul1
Option Explicit

Private Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)

Private Declare Function CallWindowProc Lib _
"user32.dll" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, _
ByVal Msg As Long, ByVal Wparam As Long, _
ByVal Lparam As Long) As Long

Private Declare Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A

Dim LocalWndProc As Long
Dim MyForm As UserForm

Private hasFocus As Boolean

Sub MainLoop()

   Do While Not DoExit
      Sleep 50
      If (ActiveSheet.Index = 1) Then
         ComboBox1.DropDown
         If hasFocus Then
         Dim direction As Long
         direction = _
         CLng(udtlParamStuct.mouseData / (2 ^ 16))
         OnMouseWheel_Scroll (direction)
         End If
      End If
      If ComboBox1.ListCount = 0 Then
        Auto_Open
      End If
   DoEvents: Loop
End Sub

Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
   MainLoop
End Sub

Private Sub ComboBox1_GotFocus()
    intTopIndex = ComboBox1.TopIndex
    Hook_Mouse
      LocalWndProc = _
      GetWindowLong(Application.Hinstance, GWL_WNDPROC)
    hasFocus = True
End Sub

Private Sub ComboBox1_LostFocus()
    UnHook_Mouse
    hasFocus = False
End Sub

Private Sub Worksheet_Activate()
   ComboBox1.Activate
   MainLoop
End Sub

Private Function WindowProc(ByVal Lwnd As Long, _
ByVal Lmsg As Long, ByVal Wparam As Long, _
ByVal Lparam As Long) As Long

Dim MouseKeys As Long
Dim Rotation As Long

   If Lmsg = WM_MOUSEWHEEL Then
      MouseKeys = Wparam And 65535
      Rotation = Wparam / 65536
      ComboBox1.MouseWheel Rotation
   End If

   WindowProc = CallWindowProc(LocalWndProc, _
   Lwnd, Lmsg, Wparam, Lparam)

End Function

Public Sub OnMouseWheel_Scroll(ByVal Rotation As Long)

   If Rotation > 0 Then
      With ComboBox1
         .TopIndex = .TopIndex - 1
      End With
   Else
      With ComboBox1
         .TopIndex = .TopIndex + 1
      End With
   End If

End Sub
'ThisWorkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
   UnHook_Mouse
   DoExit = True
End Sub

neau33 [28.03.2009 17:19:03]

#

Heippa taas!

Mouse Wheel Scroll Excel Worksheet Combobox - The Final Cut...

'Modul1
Option Explicit

Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Declare Function GetForegroundWindow _
Lib "user32" () As Long

Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (ByVal Destination As Long, _
ByVal Source As Long, ByVal Length As Long)

Declare Function SetWindowsHookEx Lib _
"user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, ByVal lpfn As Long, _
ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, ByVal nCode As Long, _
ByVal Wparam As Long, Lparam As Any) As Long

Declare Function UnhookWindowsHookEx Lib _
"user32" (ByVal hHook As Long) As Long

Public Type POINTAPI
   X As Long
   Y As Long
End Type

Type MSLLHOOKSTRUCT
   pt As POINTAPI
   mouseData As Long
   flags As Long
   time As Long
   dwExtraInfo As Long
End Type

Global Const HC_ACTION = 0, _
WH_MOUSE_LL = 14, _
WM_LBUTTONDOWN = &H201, _
WM_MOUSEWHEEL = &H20A

Private udtlParamStuct As MSLLHOOKSTRUCT

Global hhkLowLevelMouse, _
intTopIndex As Integer, _
cboList() As Variant, _
hasFocus As Boolean, _
DoExit As Boolean

Function GetHookStruct(ByVal Lparam As Variant) As MSLLHOOKSTRUCT
   CopyMemory VarPtr(udtlParamStuct), Lparam, LenB(udtlParamStuct)
   GetHookStruct = udtlParamStuct
End Function

Function LowLevelMouseProc(ByVal nCode As Long, _
ByVal Wparam As Long, ByVal Lparam As Long) As Long
   On Error Resume Next
   If GetForegroundWindow <> FindWindow( _
   "XLMAIN", Application.Caption) Then
      Sheets("Taul1").ComboBox1.TopLeftCell.Select
      UnHook_Mouse
      Exit Function
   End If
   If (nCode = HC_ACTION) Then
      If Wparam = WM_MOUSEWHEEL Then
         LowLevelMouseProc = True
         With Sheets("Taul1").ComboBox1
            If GetHookStruct(Lparam).mouseData > 0 Then
               .TopIndex = intTopIndex - 1
               intTopIndex = .TopIndex
            Else
               .TopIndex = intTopIndex + 1
               intTopIndex = .TopIndex
            End If
         End With
      End If
      Exit Function
   End If
   LowLevelMouseProc = _
   CallNextHookEx(0, nCode, Wparam, ByVal Lparam)
End Function

Sub Hook_Mouse()
   hhkLowLevelMouse = SetWindowsHookEx _
   (WH_MOUSE_LL, AddressOf LowLevelMouseProc, _
   Application.Hinstance, 0)
End Sub

Sub UnHook_Mouse()
   If hhkLowLevelMouse <> 0 Then
      UnhookWindowsHookEx hhkLowLevelMouse
   End If
End Sub

Sub Auto_Open()
   ReDim cboList(25, 2)
   DoExit = False
   Sheets(1).Activate
   Sheets(1).ComboBox1.LinkedCell = "Q1"
   Sheets(1).ComboBox1.List = listFill
   Sheets(1).ComboBox1.ListIndex = 0
   Sheets(1).MainLoop
End Sub

Function listFill() As Variant
   Dim i As Integer, j As Integer
   For i = 0 To 25
     For j = 0 To 2
        Select Case j
           Case 0
             cboList(i, j) = "Item " & CStr(i)
           Case 1
             cboList(i, j) = "Text " & CStr(i + 1)
           Case 2
             cboList(i, j) = (i + 1)
        End Select
     Next
   Next i
   listFill = cboList
End Function
'Taul1
Option Explicit

Private Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)

Private Declare Function CallWindowProc Lib _
"user32.dll" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, _
ByVal Msg As Long, ByVal Wparam As Long, _
ByVal Lparam As Long) As Long

Private Declare Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetSystemMetrics Lib _
"user32" (ByVal nIndex As Integer) As Integer

Private Const GWL_WNDPROC = -4

Private WheelScrollLines As Long, _
LocalWndProc As Long

Sub MainLoop()
   Do While Not DoExit
      Sleep 50
      If (ActiveSheet.Index = 1) And hasFocus Then
         ComboBox1.DropDown
      End If
      If ComboBox1.ListCount = 0 Then
        Auto_Open
      End If
   DoEvents: Loop
End Sub

Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
   MainLoop
End Sub

Private Sub ComboBox1_GotFocus()
   intTopIndex = ComboBox1.TopIndex
   Hook_Mouse
   LocalWndProc = _
   GetWindowLong(Application.Hinstance, GWL_WNDPROC)
   hasFocus = True
End Sub

Private Sub ComboBox1_LostFocus()
   UnHook_Mouse
   hasFocus = False
End Sub

Private Sub Worksheet_Activate()
   ComboBox1.Activate
   MainLoop
End Sub

Private Function WindowProc(ByVal Lwnd As Long, _
ByVal Lmsg As Long, ByVal Wparam As Long, _
ByVal Lparam As Long) As Long
   Dim MouseKeys As Long
   If Lmsg = WM_MOUSEWHEEL Then
      MouseKeys = Wparam And 65535
      Rotation = Wparam / 65536
      ComboBox1.MouseWheel Rotation
   End If
   WindowProc = CallWindowProc(LocalWndProc, _
   Lwnd, Lmsg, Wparam, Lparam)
End Function
'ThisWorkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
   DoExit = True
   If hasFocus Then
      UnHook_Mouse
      hasFocus = False
   End If
End Sub

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta