请教老师如何将此窗体控件修改为在EXCEL工作表中查询输入？

zengsijun

请教老师如何将此窗体控件修改为在EXCEL工作表中查询输入？


这是我在网上下载 的一个从数据库查询并选择，并可多选或全选输入的窗体，我觉得这个窗体控件很好，想把它修改下，改成从EXCEL-材料列表工作表中查询并显示在窗体列表上，并可以多选或全选输入到数据输入区当中，作为一个快速输入窗体。但因为我本人实在是不懂VBA，修改不出来里面的代码，请问要如何修成为从材料列表工作表中查询并显示在窗体列表上，并可以多选或全选输入到数据输入区当中，只需要显示和输入B、C、D、E列即可？谢谢！麻烦各位了！

zengsijun

请哪位大侠帮帮忙，帮我把里面的代码修改下，谢谢各位了！

zengsijun

有哪位大侠能帮帮忙不，谢谢了！！

longwin

请看附件.....

zengsijun

zengsijun 发表于 2024-5-8 22:35
有哪位大侠能帮帮忙不，谢谢了！！

这是所有的窗体代码，请问老师要如何修改？能否帮我修改一下！谢谢了
Private Sub CheckBox1_Click()
    lc = Me.ListBox1.ListCount
    If lc = 0 Then Exit Sub
    For i = 1 To lc
        Me.ListBox1.Selected(i - 1) = Me.CheckBox1.Value
    Next
End Sub
Private Sub ComboBox1_Change()
    If ComboBox1 = "" Then
        UserForm_Initialize
    Else
        CommandButton1_Click
    End If
End Sub

Private Sub UserForm_Initialize()
    Set cnn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    Dim DBPath$, i%, yn&
    DBPath = ThisWorkbook.Path & "\XS.mdb"
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPath & ";Jet OLEDB:Database Password=hqlin123456"
    Operator = " WHERE TRUE "
    sql1 = "SELECT DISTINCT 货物名称及规格,单位,单价 FROM 销售表" & Operator & "AND NOT 货物名称及规格 IS NULL ORDER BY 货物名称及规格"
    rs.Open sql1, cnn, 1, 3
    If rs.RecordCount = 0 Then MsgBox "数据库没有任何数据！": Exit Sub
    Me.ListBox1.List = Application.WorksheetFunction.Transpose(rs.GetRows)
    sq = "SELECT DISTINCT  客户名称  FROM 销售表"
    rs.Close
    rs.Open sq, cnn, 1, 3
    ARR = rs.GetRows
    ComboBox1.Clear
    TextBox4 = ""
    For i = 0 To UBound(ARR, 2)        '对ComboBox赋值
        If ARR(0, i) <> "" Then ComboBox1.AddItem ARR(0, i)
    Next
    rs.Close
End Sub
Private Sub CommandButton1_Click()  '模糊查询
    Me.ListBox1.Clear
    Set cnn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    Dim DBPath$, i%, yn&
    DBPath = ThisWorkbook.Path & "\XS.mdb"
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPath & ";Jet OLEDB:Database Password=hqlin123456"
    KH = ComboBox1
    If Len(Trim(TextBox4.Text)) Then
        If KH = "" Then
            Operator = " WHERE 货物名称及规格 & 单位 & 单价 Like '%" & TextBox4.Text & "%' "
        Else
            Operator = " WHERE 货物名称及规格 & 单位 & 单价 Like '%" & TextBox4.Text & "%'  And 客户名称 ='" & KH & "' "
        End If
    Else
        Operator = " WHERE  客户名称 ='" & KH & "' "
    End If
    sql1 = "SELECT DISTINCT 货物名称及规格,单位,单价 FROM 销售表" & Operator & " AND NOT 货物名称及规格 IS NULL ORDER BY 货物名称及规格"
    rs.Open sql1, cnn, 1, 3
    If rs.RecordCount = 0 Then MsgBox "数据库没有任何数据！": Exit Sub
    If rs.RecordCount = 1 Then
        ARR = Application.WorksheetFunction.Transpose(rs.GetRows)
        ListBox1.AddItem
        For i = 0 To 2
            ListBox1.List(0, i) = ARR(i + 1)
        Next
    Else
        Me.ListBox1.List = Application.WorksheetFunction.Transpose(rs.GetRows)
    End If
End Sub
Private Sub ListBox1_Change()    '单击激活货物名称及规格,单位,单价
    Dim i%, m%
    For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) Then
            m = m + 1
        End If
    Next
    If m > 0 Then
        Label1.Caption = "本次共选择了 " & m & " 条信息"
    Else
        Label1.Caption = ""
    End If
End Sub
Private Sub 确定_Click()    '赋值从非空单元格开始
    lc = Me.ListBox1.ListCount
    If lc = 0 Then Exit Sub
    If Label1 = "" Then MsgBox "你没有选择货物！": Exit Sub
    last = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row
    For i = 1 To lc
        If Me.ListBox1.Selected(i - 1) Then
            last = last + 1
            Sheet3.Cells(last, "A") = last - 7
            Sheet3.Cells(last, "C") = Me.ListBox1.List(i - 1, 0)
            Sheet3.Cells(last, "I") = Me.ListBox1.List(i - 1, 1)
            Sheet3.Cells(last, "K") = Me.ListBox1.List(i - 1, 2)
        End If
    Next
    Unload Me    '退出窗体
    Sheet3.Range("A2:L" & [A65536].End(xlUp).Row + 1).Borders.LineStyle = xlContinuous    '最后非空加一行加上边框
End Sub

zengsijun

谢谢您的热心帮助，能否再帮我修改一下，在上面商品资料选择下拉窗口上帮我把材料名称做一个下拉选择分类，以便于查询输入，谢谢！！

longwin

zengsijun 发表于 2024-5-9 02:02
谢谢您的热心帮助，能否再帮我修改一下，在上面商品资料选择下拉窗口上帮我把材料名称做一个下拉选择分类， ...

[url=]附件[/url]

zengsijun

谢谢longwin老师的热心帮助，圆满地解决了我的问题！

feilanga

我个人还是喜欢这种录入方式。鼠标双击需要录入的区域，调用窗体

feilanga

.........