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

我有一个用户窗体，它应该能够理想地复制粘贴单元格。因此，首先我要单击要复制的范围，然后激活UserForm。 UserForm将有一个组合框，供我选择要在其中粘贴数据的工作表，此后它将转到该工作表，并且用户将单击要粘贴数据的范围或单元格。

我最初是通过输入框代码来做到这一点的，它可以完美地工作，但是当我在UserForm中执行此操作时，它无法工作，因为我无法在文本框中包含Type:=8代码。因此，我将需要一些有关如何启用我的用户窗体将单元格数据粘贴到工作表上的帮助，这与我在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

最佳答案

您不需要组合框导航到工作表。那就是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$1:$A$3复制到Sheet2!$A$1:$A$3

后续评论


但是，该粘贴链接功能已在用户表单中丢失。是否可以合并？：） –尼瓦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