Excel VBA插入InputBox来粘贴大文本
我有一个macros，我想用它来允许用户从电子邮件粘贴文本，并会自动识别和组织填写表格的信息。
我的问题是，当简单的“粘贴”过程。
我的想法是插入一个input框或用户窗体，用户将能够粘贴整个电子邮件文本。 虽然它没有像我期待的那样工作。
通常当你在范围（“A2”）使用CTRL + V（比方说）时，文本将像电子邮件一样逐行分割。
是否有可能做到这一点，但与框提示？ 还是只允许插入less量的数据，只能在1行？
我的代码1）
EmailText = InputBox("Please insert Email Text Below") wsRep.Range("A2").Value = EmailText “它只复制第一行
与提示用户窗体相同的问题 – NameTextBox
任何人都可以请build议任何其他方式来做到这一点？
（我想避免用户不得不在工作表之间切换或者粘贴）
提前谢谢了。
解：
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
你也许可以使用这样的东西：
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
在input框中，CR + LF（vbCrLf）分隔线条。 在单元格中，LF（vbLf）分隔线条。 线分隔符的这种差异可能会导致您的问题。
尝试下面的代码，而不是代码“我的代码1”）。
EmailText = InputBox("Please insert Email Text Below") wsRep.Range("A2").Value = Replace(EmailText, vbCrLf, vbLf)