在用户窗体中使用 TextBox 捕获单元格值

Question

我有一个用户窗体，它应该能够理想地复制粘贴单元格。所以首先我会点击我想要复制的范围，然后激活用户窗体。用户窗体将有一个组合框来选择我想将数据粘贴到哪个 sheet 中，然后它将转到 sheet 并且用户将单击他想要数据的范围或单元格粘贴。

我最初编写了一个输入框代码来执行此操作并且它工作得很好，但是当我在用户窗体中执行它时它不起作用，因为我无法将 Type:=8 代码合并到文本框中。因此，我需要一些帮助，让我的用户窗体能够将单元格数据粘贴到 sheet，类似于我在 application.inputbox.

中所做的

这是输入框形式的完美工作代码：

Sub CopyPasteCumUpdateWithinSameSheet()


Dim rng As Range
Dim inp As Range

Selection.Interior.ColorIndex = 37
Set inp = Selection
On Error Resume Next
Set rng = Application.InputBox("Copy to", Type:=8)
 On Error GoTo 0
    If TypeName(rng) <> "Range" Then
        Exit Sub
    Else
inp.Copy

rng.Select

ActiveSheet.Paste Link:=True

'Cells(1,2).Font.ThemeColor =

End If

End Sub

这是我试过的用户表单：

Dim Sh As Worksheet

Private Sub CommandButton1_Click()
On Error GoTo 0
    If TypeName(rng) <> "Range" Then
        Exit Sub
    Else
inp.Copy

rng.Select

ActiveSheet.Paste Link:=True
End If

End Sub

Private Sub UserForm_Initialize()

CopyPasteUserform.Show vbModeless
    For Each Sh In ThisWorkbook.Sheets
        If Sh.Name <> "Inputs" Then
            ComboBox1.AddItem Sh.Name
        End If
    Next

    ComboBox1.Style = fmStyleDropDownList
End Sub



Private Sub ComboBox1_Change()
With ThisWorkbook.Sheets(ComboBox1.Text)
        .Visible = xlSheetVisible
        .Activate
    End With


End Sub

Private Sub TextBox1_Change()



Dim rng As Range
Dim inp As Range

Selection.Interior.ColorIndex = 37
Set inp = Selection
On Error Resume Next
Set rng = TextBox.Value




End Sub

我尝试合并用户窗体，但除了 RefEdit 之外的所有其他功能都停止响应。

Dim Sh As Worksheet


Private Sub UserForm_Initialize()

CopyPasteUserform.Show vbModeless
    For Each Sh In ThisWorkbook.Sheets
        If Sh.Name <> "Inputs" Then
            ComboBox1.AddItem Sh.Name
        End If
    Next

    ComboBox1.Style = fmStyleDropDownList

Dim rng As Range
Dim inp As Range

Selection.Interior.ColorIndex = 37
Set inp = Selection
End Sub



Private Sub Combobox1_Change()
With ThisWorkbook.Sheets(ComboBox1.Text)
        .Visible = xlSheetVisible
        .Activate
    End With


End Sub

Private Sub RefEdit1_Change()
    Label1.Caption = ""

    If RefEdit1.Value <> "" Then _
    Label1.Caption = "[" & ComboBox1 & "]" & RefEdit1
    Dim rng As Range
Dim inp As Range


On Error Resume Next
Set rng = RefEdit1.Value
 On Error GoTo 0
    If TypeName(rng) <> "Range" Then
        Exit Sub
    Else
inp.Copy

rng.Select

ActiveSheet.Paste Link:=True

End If

End Sub

Answer 1

描述：Type:=8 将检查用户输入的范围名称是否正确？在UserForm 中的TextBox 没有这个功能。但是当用户点击按钮时我们可以检测到这个错误。看我的代码。

文本框改变时不需要检查，我删除了textbox_change的代码。

在您的用户表单代码区域中替换下面。

Option Explicit
Dim Sh As Worksheet
Dim inp As Range
Dim rng As Range

Private Sub CommandButton1_Click()
    ActiveCell.Value = Me.TextBox1.Text
    'On Error Resume Next
    'If TypeName(Range(Me.TextBox1.Text)) <> "Range" Then
    '    MsgBox "Invalid range name!", vbCritical
    '    Exit Sub
    'Else
    '    inp.Copy
    '    rng.Select
    '    
    '    ActiveSheet.Paste Link:=True
    '    MsgBox "Copy and paste finish.", vbInformation
    'End If
    'On Error GoTo 0
End Sub

Private Sub UserForm_Initialize()
For Each Sh In ThisWorkbook.Sheets
    If Sh.Name <> "Inputs" Then
        ComboBox1.AddItem Sh.Name
    End If
Next

ComboBox1.Style = fmStyleDropDownList
End Sub

Private Sub ComboBox1_Change()
With ThisWorkbook.Sheets(ComboBox1.Text)
    .Visible = xlSheetVisible
    .Activate
End With
End Sub

Answer 2

您不需要组合框来导航到工作表。这就是Refedit

的美

这是您正在尝试的吗？我没有做任何错误处理。我相信你能解决这个问题。

创建一个用户表单并放置 2 个标签、2 个重新编辑和 1 个命令按钮，如下所示
接下来将这段代码粘贴到用户表单代码区

代码

Private Sub CommandButton1_Click()
    Dim rngCopy As Range, rngPaste As Range
    Dim wsCopy As Worksheet, wsPaste As Worksheet

    If RefEdit1.Value <> "" And RefEdit2.Value <> "" Then
        Set wsCopy = ThisWorkbook.Sheets(Replace(Split(RefEdit1.Value, "!")(0), "'", ""))
        Set rngCopy = wsCopy.Range(Split(RefEdit1.Value, "!")(1))

        Set wsPaste = ThisWorkbook.Sheets(Replace(Split(RefEdit2.Value, "!")(0), "'", ""))
        Set rngPaste = wsPaste.Range(Split(RefEdit2.Value, "!")(1))

        rngCopy.Copy rngPaste
    Else
        MsgBox "Please select Input and Output range"
    End If
End Sub

在行动

数据将从Sheet1!$A:$A复制到Sheet2!$A:$A

评论跟进

However the pastelink feature has been missed out in the userform. Is it possible to incorporate it?:) – Niva 7 mins ago

在表单中添加一个复选框，如下所示

使用此代码

Private Sub CommandButton1_Click()
    Dim rngCopy As Range, rngPaste As Range
    Dim wsCopy As Worksheet, wsPaste As Worksheet

    If RefEdit1.Value <> "" And RefEdit2.Value <> "" Then
        Set wsCopy = ThisWorkbook.Sheets(Replace(Split(RefEdit1.Value, "!")(0), "'", ""))
        Set rngCopy = wsCopy.Range(Split(RefEdit1.Value, "!")(1))

        Set wsPaste = ThisWorkbook.Sheets(Replace(Split(RefEdit2.Value, "!")(0), "'", ""))
        Set rngPaste = wsPaste.Range(Split(RefEdit2.Value, "!")(1))

        If CheckBox1.Value = True Then
            wsPaste.Activate
            rngPaste.Select
            rngCopy.Copy
            ActiveSheet.Paste Link:=True
        Else
            rngCopy.Copy rngPaste
        End If
    Else
        MsgBox "Please select Input and Output range"
    End If
End Sub

在用户窗体中使用 TextBox 捕获单元格值

Capture cell value with TextBox in UserForm

excel

vba

userform