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
20190227xlVBA辅助输入的更多相关文章
- Eclipse输入任意字母或指定字符出现提示框
Eclipse默认是输入"."的时候会有提示框提示对应的API. 如果想更方便的输入任意字母或者指定的符号出现提示框设置如下: 打开Eclipse,选中“Window”->& ...
- C# 自定义控件,日期时间选择输入插件
权声明:本文为博主原创文章,未经博主允许不得转载. // 为textBox1添加一个日期时间选择控件 DateTimeChoser.AddTo(textBox1); DateTimeChoser.De ...
- HTML5权威指南--标签新变化,文件API,拖放API(简要学习笔记一)
1.标签元素更加语义化 2.内容类型仍然为“text/html” 扩展符仍然为html或者htm. <1>DOCTYPE 声明<!DOCTYPE html>就可 ...
- Sublime Text 3 杂记
Sublime Text 是一个功能强大的代码编辑器(收费,但可无限期试用).由程序员Jon Skinner于2008年1月份所开发出来,它最初被设计为一个具有丰富扩展功能的Vim.Sublime T ...
- 键盘事件keydown、keypress、keyup随笔整理总结(摘抄)
原文1:http://www.cnblogs.com/silence516/archive/2013/01/25/2876611.html 原文2:http://www.cnblogs.com/leo ...
- 基于Jquery Validate 的表单验证
基于Jquery Validate 的表单验证 jquery.validate.js是jquery下的一个验证插件,运用此插件我们可以很便捷的对表单元素进行格式验证. 在讲述基于Jquery Vali ...
- 你有没有试过“闭上眼”使用:京东、滴滴、QQ、支付宝?
正在看这篇文章的同学,也许是幸运的. 互联网的发展,让我们的生活越来越便利,但这个“我们”,也许并不包括那些残障人士.正常人眼里来说再简单不过的页面操作,对于盲人来说都是不可攀越的高墙.换句话说,越行 ...
- Struts个人总结
编写Struts2第一个程序 Struts2是目前最流行的MVC框架,吸收了传统Struts和WebWork两者的精华,基于Struts2来进行开发可以大大减少开发时间,提高开发效率,并降低后期维护时 ...
- Mditor 发布「桌面版」了 - http://mditor.com
简单说明 Mditor 最早只有「组件版」,随着「桌面版」的发布,Mditor 目前有两个版本: 可嵌入到任意 Web 应用的 Embed 版本,这是一桌面版的基础,Repo: https://git ...
随机推荐
- php 延迟静态绑定: static关键字
abstract class DomainObject { public static function create() { return new self(); } } class User ex ...
- mysql数据库的主从同步,实现读写分离 g
https://blog.csdn.net/qq_15092079/article/details/81672920 前言 1 分别在两台centos 7系统上安装mysql 5.7 2 master ...
- 从Windows到linux小记
从Windows到linux小记 年后疯狂加班,趁着喘息的时间,更新一下安装linux的艰辛路程. 周四晚上,公司举办活动,好不容易从加班的节奏暂时脱离出来,我这人就是不能闲,只要一闲下来就会做die ...
- select()函数 的学习
select()的介绍 全是拷贝的如下文章: https://www.cnblogs.com/wenqiang/p/5508541.html select()函数的用例代码摘录如下文章: https: ...
- Please run SwitchHosts! as an Administrator 原因
github 访问慢的初期,不得已修改host,但直接修改host的文件太不够灵活了,使用switchhost工具. win10 遇到上述问题如这个地址 要撞墙了. 解决方法: 进入 C:\Windo ...
- sx1278 手册参考
记录下芯片的重要数据和内容,方便查阅,无代码实现 参考程序地址:http://www.pudn.com/Download/item/id/3070942.html http://www.cirmal ...
- [摘抄] Bezier曲线、B样条和NURBS
Bezier曲线.B样条和NURBS,NURBS是Non-Uniform Rational B-Splines的缩写,都是根据控制点来生成曲线的,那么他们有什么区别了?简单来说,就是: Bezier曲 ...
- cocos2d JS-(JavaScript) 冒泡排序
思想: 比较相邻的元素.如果第一个比第二个大,就交换他们两个. 对每一对相邻元素作同样的工作,从开始第一对到结尾的最后一对.在这一点,最后的元素应该会是最大的数. 针对所有的元素重复以上的步骤,除了最 ...
- SQL Server通过BCP进行大批量数据导入导出
预置条件: 使用sa帐号登录SQL Server Management Studio,右键点击安全性-登录名-数据库用户名属性,设置服务器角色为sysadmin. 删除已存在的存储过程 String ...
- PostgreSQL在Update时使用Substring函数截取字符串并且加上CASE WHEN THEN条件判断
--更新 UPDATE wp_order_detail SET layout_type = ( SELECT CASE THEN ) ELSE '' END FROM wp_catalog_size ...