Excel VBA插入输入框以粘贴大文本答案

【问题标题】：Excel VBA Insert InputBox to paste large textExcel VBA插入输入框以粘贴大文本
【发布时间】：2016-02-15 21:21:22
【问题描述】：

我有一个宏，我想用它来允许用户从电子邮件中粘贴文本，并自动识别和组织信息以填写表格。

我的问题是要简化“粘贴”过程。

我的想法是插入一个 InputBox 或一个用户表单，用户可以在其中粘贴整个电子邮件文本。虽然没有达到我的预期。

通常当您在 Range("A2") 中使用 CTRL+V（比方说）时，文本会像在电子邮件中一样逐行拆分。

是否可以做同样的事情，但有一个框提示？还是它只允许插入少量数据并且只在 1 行中？

我的代码 1)

EmailText = InputBox("Please insert Email Text Below")

    wsRep.Range("A2").Value = EmailText

'它只复制第一行

提示用户表单的相同问题 - NameTextBox

请问有没有其他方法可以解决？

（我想避免用户不得不在工作表之间切换或做任何事情，除了粘贴）

非常感谢。

解决方案：

Dim oDO As DataObject
Dim tmpArr As Variant
Dim Cell As Range
Set oDO = New DataObject
'First we get the information from the clipboard
If MsgBox("Please copy the text from the email and then press OK",      vbOKCancel) = vbOK Then
    oDO.GetFromClipboard
'Here we send the ClipBoard text to a new string which will contain all the Information (all in 1 line)
    sTxt = oDO.GetText
    wsRep.Range("A2") = sTxt 'Range is up to you

'Now we can split the email information using the "line break" and this code (found it [here][1])
    Application.Goto Reference:=wsRep.Range("A1") 'I need to move to the worksheet to run this code
'This code split each line using the criteria "break line" in rows
    For Each Cell In wsRep.Range("A2", Range("A2").End(xlDown))
    If InStr(1, Cell, Chr(10)) <> 0 Then
        tmpArr = Split(Cell, Chr(10))

        Cell.EntireRow.Copy
        Cell.Offset(1, 0).Resize(UBound(tmpArr), 1). _
            EntireRow.Insert xlShiftDown

        Cell.Resize(UBound(tmpArr) + 1, 1) = Application.Transpose(tmpArr)
    End If
    Next
    Application.CutCopyMode = False

    End If

【问题讨论】：

对于用户窗体，您是否设置了文本框的Multiline 属性？默认为 false，您应该将其设置为 true。

标签： vba excel

【解决方案1】：

也许你可以使用这样的东西：

Sub ProcessClipboard()
'first step: Go to Tools, references and check "Microsft Forms 2.0 Object library"
    Dim oDO As DataObject
    Set oDO = New DataObject
    If MsgBox("Please copy the text from the email and then press OK", vbOKCancel) = vbOK Then
        oDO.GetFromClipboard
        MsgBox oDO.GetText
    End If
End Sub

【讨论】：

我喜欢这种方法！问题：将文本粘贴到范围 A2？我尝试使用 Range("A2").Value = oDO.GetText -- 没有意义 :D 和 Range("A2").PasteSpecial -- 它将它粘贴到一个单独的块中（如图像）。我正在尝试弄清楚如何做到这一点，欢迎任何帮助！
您还没有告诉我们您想对剪贴板中的信息做什么。我向您展示的是一种将这些信息转换为 VBA 字符串的方法，因此您可以将我给您的 MsgBox 替换为 sTxt = oDO.GetText，然后在您的代码中解析 sTxt 中的文本以根据需要进行处理
我根据您的建议找到了解决方法 :) 非常感谢！

【解决方案2】：

在输入框中，CR+LF(vbCrLf) 分隔行。在单元格中，LF(vbLf) 分隔行。行分隔符的这种差异可能会导致您的问题。

尝试以下代码，而不是代码“我的代码 1)”。

EmailText = InputBox("Please insert Email Text Below")

wsRep.Range("A2").Value = Replace(EmailText, vbCrLf, vbLf)

【讨论】：

对不起#Fumu_7，我没有充分解释这个问题。