我想在VBA中运行执行以下操作的代码:
到目前为止我所拥有的是:
Sub CreateAfile()
Dim pth As String
pth = ThisWorkbook.path
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Dim a As Object
Set a = fs.CreateTextFile(pth & "\Kommentar.txt", True)
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Kommentar")
Dim rng As Range
Set rng = sh.UsedRange
a.WriteLine (rng)
a.Close
End Sub
我得到一个运行时错误'13'不匹配,就像在行“a.WriteLine(rng)”中一样,该函数不接受要写入的范围。
任何想法? 谢谢!
答案 0 :(得分:5)
由于您的范围可能由多个单元组成,因此您必须遍历它们以将所有文本转换为字符串变量。如果使用Variant变量,则可以复制值并自动获取具有单元格中所有数据的正确尺寸的数组,然后循环并复制文本:
Function GetTextFromRangeText(ByVal poRange As Range) As String
Dim vRange As Variant
Dim sRet As String
Dim i As Integer
Dim j As Integer
If Not poRange Is Nothing Then
vRange = poRange
For i = LBound(vRange) To UBound(vRange)
For j = LBound(vRange, 2) To UBound(vRange, 2)
sRet = sRet & vRange(i, j)
Next j
sRet = sRet & vbCrLf
Next i
End If
GetTextFromRangeText = sRet
End Function
通过使用以下内容替换a.WriteLine (rng)
行来调用代码中的函数:
Dim sRange As String
sRange = GetTextFromRangeText(rng)
Call a.WriteLine(sRange)
答案 1 :(得分:2)
不确定你能做到这一点。我相信你必须逐行写出来。
这是另一种选择。
您可以尝试将工作表另存为.txt文件,而不是使用FSO。
这是一些示例代码。
积分应转到http://goo.gl/mEHVx
Option Explicit
'Copy the contents of a worksheet, and save it as a new workbook as a .txt file
Sub Kommentar_Tab()
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim wbDest As Workbook
Dim fName As String
'References
Set wbSource = ActiveWorkbook
Set wsSource = ThisWorkbook.Sheets("Kommentar")
Set wbDest = Workbooks.Add
'Copy range on original sheet
'Using usedrange can be risky and may return the wrong result.
wsSource.UsedRange.Copy
'Save in new workbook
wbDest.Worksheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
'Get file name and location
fName = ThisWorkbook.Path & "\Kommentar.txt"
'Save new tab delimited file
wbDest.SaveAs fName, xlText
wbDest.Close SaveChanges:=True
End Sub
答案 2 :(得分:0)
假设yourRange
是您要复制为字符串的范围。
yourRange
。复制以复制它。 GetFromClipboard
和GetText
方法将其保存到字符串变量。CreateTextFile
将其保存到文件中。答案 3 :(得分:0)
@xwhitelight 给出了一个很好的轮廓。谢谢。但我需要向自己提供细节来完成我自己的任务,并认为我会分享。
首先,需要一个 Reference
到 Microsoft Scripting Runtime
和另一个到 Microsoft Forms 2.0 Object Library
。
我为生成输出文件而添加的编码细节如下。
请注意,textfilename
是包含电子表格范围的输出文件的完全限定名称。
请注意,textfilename
是在 sub
的最后一行打开的,这不是必需的,但可以放心查看文件包含的内容。当然,MsgBox
也是不必要的。
Sub turnRangeIntoTextFile(rg As Range, textfilename As String)
Dim textFile as TextStream
Dim fs As FileSystemObject
Dim myData As DataObject
Set myData = New DataObject
Set fs = CreateObject("Scripting.FileSystemObject")
rg.Copy
myData.GetFromClipboard
MsgBox myData.GetText ' reassurance (see what I got)
Set textFile = fs.CreateTextFile(textfilename, True)
textFile.WriteLine (myData.GetText)
textFile.Close
CreateObject("Shell.Application").Open (textfilename)
End Sub