zoukankan      html  css  js  c++  java
  • 20190227xlVBA辅助输入

    Dim tg As Range
    Dim FreeInput As Boolean
    Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
        Debug.Print "Not tg Is Nothing  "; (Not tg Is Nothing)
        If Not tg Is Nothing Then
            tg.Value = Me.ListBox1.Value
            tg.Offset(, 1).Select
        End If
    End Sub
    
    Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
          If KeyCode = 9 Or KeyCode = 13 Then
          Debug.Print "Not tg Is Nothing  "; (Not tg Is Nothing)
                If Not tg Is Nothing Then
                      tg.Value = Me.ListBox1.Value
                      tg.Offset(, 1).Select
                End If
          Else
          
          End If
    End Sub
    
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Set tg = Target
        If Target.Cells.Count = 1 And (Target.Column = 3 Or Target.Column = 4 Or Target.Column = 5) And Target.Row > 3 Then
            If Not FreeInput Then
                Call ShowTwo
                Call TextboxFollow(Target)
                Call ListboxFollow(Target)
                Call ChangeListboxItems(Me.TextBox1.Text, Target.Column - 2)
            Else
                Call ShowOne
                Me.ListBox1.Clear
                Call TextboxFollow(Target)
            End If
        Else
            Call ShowNone
        End If
    End Sub
    Sub ShowTwo()
          Me.TextBox1.Visible = True
          Me.ListBox1.Visible = True
    End Sub
    Sub ShowOne()
          Me.TextBox1.Visible = True
          Me.ListBox1.Visible = False
    End Sub
    Sub ShowNone()
          Me.TextBox1.Visible = False
          Me.ListBox1.Visible = False
          Me.ListBox1.Clear
    End Sub
    Sub TextboxFollow(ByVal Rng As Range)
        With Me.TextBox1
             .Text = Rng.Value
            .Visible = True
            .Left = Rng.Left
            .Top = Rng.Top
            .Width = Rng.Width
            .Height = Rng.Height
            .Activate
        End With
    End Sub
    Sub ListboxFollow(ByVal Rng As Range)
        With Me.ListBox1
            .Clear
            .Visible = True
            .Left = Rng.Offset(0, 1).Left
            .Top = Rng.Offset(0, 1).Top
            .Width = 2 * Rng.Width
            .Height = 10 * Rng.Offset(0, 1).Height
        End With
    End Sub
    Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        'Debug.Print KeyCode
        If KeyCode = 69 Then
            If Shift = 2 Then
                FreeInput = Not FreeInput
                If FreeInput Then
                    MsgBox "切换为任意输入状态"
                    Call Worksheet_SelectionChange(tg)
                Else
                    MsgBox "切换为提示输入状态"
                    Call Worksheet_SelectionChange(tg)
                End If
            End If
        ElseIf KeyCode = 9 Or KeyCode = 13 Then
            If Not FreeInput Then
                If Me.ListBox1.ListCount > 0 Then
                    Me.ListBox1.Activate
                    Me.ListBox1.ListIndex = 0
                End If
            Else
                If Not tg Is Nothing Then
                    tg.Value = Me.TextBox1.Text
                    tg.Offset(, 1).Select
                End If
            End If
        End If
    End Sub
    Private Sub TextBox1_Change()
          Debug.Print "TextBox1_Change"
      Call ChangeListboxItems(Me.TextBox1.Text, tg.Column - 2)
    End Sub
    Sub ChangeListboxItems(ByVal TextInput As String, ByVal DATA_COLUMN As Long)
        'If Len(TextInput) > 0 Then
            Debug.Print "ChangeListboxItems now"
            With ThisWorkbook.Worksheets("data")
                endrow = .Cells(.Cells.Rows.Count, DATA_COLUMN).End(xlUp).Row
                Me.ListBox1.Clear
                For i = 2 To endrow
                    If InStr(.Cells(i, DATA_COLUMN).Value, TextInput) > 0 Then
                        Me.ListBox1.AddItem .Cells(i, DATA_COLUMN).Value
                    End If
                Next i
            End With
        'End If
    End Sub
    

      

  • 相关阅读:
    centos PIL 安装
    apache virtualhost 针对ip开放访问
    基础练习 矩形面积交 (分类讨论)
    UVa 10163 Storage Keepers (二分 + DP)
    UVaLive 5009 Error Curves (三分)
    UVa 11542 Square (高斯消元)
    UVa 10828 Back to Kernighan-Ritchie (数学期望 + 高斯消元)
    基础练习 回形取数 (循环 + Java 输入输出外挂)
    UVaLive 3704 Cellular Automaton (循环矩阵 + 矩阵快速幂)
    勇敢的妞妞 (状压 + 搜索)
  • 原文地址:https://www.cnblogs.com/nextseven/p/10447393.html
Copyright © 2011-2022 走看看