使用UserForm中的TextBox捕获单元格值

Question

我有一个UserForm应该能够理想地复制粘贴单元格。 首先，我会单击我想要复制的范围，然后激活UserForm。 UserForm将有一个组合框来选择我要粘贴数据的工作表，然后它将转到该工作表，用户将单击他想要粘贴数据的范围或单元格。

我最初做了一个输入框代码来完成这个并且它完美地运行，但是当我在UserForm中执行它时它不起作用，因为我无法在文本框中包含Type:=8代码。 因此，我需要一些帮助，如何启用我的UserForm粘贴工作表上的单元格数据，类似于我在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

这是我试过的UserForm：

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

我尝试合并UserForm但所有其他功能都停止响应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

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

这是你在尝试什么？ 我没有做任何错误处理。 我相信你可以照顾到这一点。

1. 创建一个userform并放置2个标签，2个refedits和1个commandbutton，如下所示

   

2. 接下来将此代码粘贴到userform代码区域中

码

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$1:$A$3复制到Sheet2!$A$1:$A$3

来自评论的后续

但是，在用户表单中错过了pastelink功能。 是否可以加入它？:) - Niva 7分钟前

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

使用此代码

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

Answer 2

说明：类型：= 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