[已解决]求帮忙修改动态跨表用户窗体下拉单数据源的连接

weishikey

求动态用户窗体下拉菜单代码.rar (12.53 KB, 下载次数: 14)

2012-9-6 16:17 上传

点击文件名下载附件 如何动态连接另一张工作表某列的内容，将该列内容作为用户输入窗体下拉菜单的数据源？谢谢!

最佳答案

月排行榜 / 总排行榜

suye1010

2012-9-9 18:00

求动态用户窗体下拉菜单代码.zip (13.22 KB, 下载次数: 60)

2012-9-9 17:59 上传

点击文件名下载附件

控件的名称改变后，必须重新选择一下事件并输入代码才会起作用。

跳转到最佳答案楼层

wcymiss

{:251:}是UserForm_Initialize，不是UserForm1_Initialize；是ComboBox1.AddItem，不是ComboBox2.AddItem{:241:}

weishikey

wcymiss 发表于 2012-9-6 20:21
是UserForm_Initialize，不是UserForm1_Initialize；是ComboBox1.AddItem，不是ComboBox2.AddItem{: ...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 2 And Target.Row > 1 And Target.Row < 10000 Then
Set Sh = Sheets("sheet2")
     Mrow = Target.Row
     UserForm.Show
    End If
End Sub

按照你的指导，把UserForm1 改成UserForm ,把Combobox2改成Combobox1,还是没出现菜单。能不能帮忙看看，把附件给做好？先谢了。真的急用。

wcymiss

{:021:}是userForm1.show,不是userForm.show

weishikey

wcymiss 发表于 2012-9-6 22:36
是userForm1.show,不是userForm.show

改叻以后，点击B列就得空白框，没有链接到表2的A列数据。

weishikey

怎样在点击表1的B列，出现用户窗体（已实现）下拉菜单，选择后填到B列。菜单内容为表2A列的数据（表2A列数据时动态的），如何才能使窗体下拉菜单的内容和表2的链接起来？帮改改代码。谢谢。

最佳答案

月排行榜 / 总排行榜

suye1010

2012-9-9 18:00

求动态用户窗体下拉菜单代码.zip (13.22 KB, 下载次数: 60)

2012-9-9 17:59 上传

点击文件名下载附件

控件的名称改变后，必须重新选择一下事件并输入代码才会起作用。

跳转到最佳答案楼层

suye1010

求动态用户窗体下拉菜单代码.zip (13.22 KB, 下载次数: 60)

2012-9-9 17:59 上传

点击文件名下载附件

控件的名称改变后，必须重新选择一下事件并输入代码才会起作用。

weishikey

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Me.DTPicker1
        If Target.Count = 1 And Target.Column = 2 And (Not Target.Row < 7) Or Target.MergeCells Then
            .Visible = True
            .Top = Selection.Top
            .Left = Selection.Left
            .Height = Selection.Height
            .Width = Selection.Width
            If Target.Cells(1, 1) <> "" Then
                .Value = Target.Cells(1, 1).Value
            Else
                .Value = Date
            End If
        Else
            .Visible = False
        End If
    End With
End Sub
Private Sub DTPicker1_CloseUp()
    ActiveCell.Value = Me.DTPicker1.Value
    Me.DTPicker1.Visible = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 And Target.Column = 2 Or Target.MergeCells Then
        If Target.Cells(1, 1).Value = "" Then
            DTPicker1.Visible = False
        End If
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)  '输入职工姓名
On Error Resume Next
If Target.Column = 2 And Target.Row > 6 And Target.Row < 10000 Then
     Mrow = Target.Row
     UserForm1.Show
Else
    Unload UserForm1
End If
End Sub

Private Sub Calendar1_Click()
ActiveCell = Calendar1.Value
Me.Calendar1.Visible = False
End Sub
这行黄字与上面发生二意，又该怎么改？我是VAB白菜，搬别人的来用，我想目前是我最好的选择。VBA道道太多，不像函数好“移植”，麻烦再帮整整。多谢！

weishikey

suye1010 发表于 2012-9-9 18:00
控件的名称改变后，必须重新选择一下事件并输入代码才会起作用。

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Me.DTPicker1
        If Target.Count = 1 And Target.Column = 2 And (Not Target.Row < 7) Or Target.MergeCells Then
            .Visible = True
            .Top = Selection.Top
            .Left = Selection.Left
            .Height = Selection.Height
            .Width = Selection.Width
            If Target.Cells(1, 1) <> "" Then
                .Value = Target.Cells(1, 1).Value
            Else
                .Value = Date
            End If
        Else
            .Visible = False
        End If
    End With
End Sub
Private Sub DTPicker1_CloseUp()
    ActiveCell.Value = Me.DTPicker1.Value
    Me.DTPicker1.Visible = False
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 And Target.Column = 2 Or Target.MergeCells Then
        If Target.Cells(1, 1).Value = "" Then
            DTPicker1.Visible = False
        End If
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)  '输入职工姓名
On Error Resume Next
If Target.Column = 2 And Target.Row > 6 And Target.Row < 10000 Then
     Mrow = Target.Row
     UserForm1.Show
Else
    Unload UserForm1
End If
End Sub

Private Sub Calendar1_Click()
ActiveCell = Calendar1.Value
Me.Calendar1.Visible = False
End Sub
这行黄字与上面发生二意，又该怎么改？我是VAB白菜，搬别人的来用，我想目前是我最好的选择。VBA道道太多，不像函数好“移植”，麻烦再帮整整。多谢！