VBA复制使用范围到文本文件

时间:2013-05-06 08:51:10

标签: excel vba excel-vba copy range

我想在VBA中运行执行以下操作的代码:

  • 复制名为“Kommentar”
  • 的工作表的已用范围
  • 在ThisWorkbook所在的目录中创建“.txt”文件(“Kommentar.txt”)
  • 粘贴以前复制的已使用范围
  • 保存“.txt”文件

到目前为止我所拥有的是:

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)”中一样,该函数不接受要写入的范围。

任何想法? 谢谢!

4 个答案:

答案 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是您要复制为字符串的范围。

  1. 使用yourRange。复制以复制它。
  2. 复制后,Excel将文本值保存到剪贴板。行中的单元格由制表符分隔,每行以Enter结尾。您可以使用DataObject的GetFromClipboardGetText方法将其保存到字符串变量。
  3. 使用CreateTextFile将其保存到文件中。

答案 3 :(得分:0)

@xwhitelight 给出了一个很好的轮廓。谢谢。但我需要向自己提供细节来完成我自己的任务,并认为我会分享。

首先,需要一个 ReferenceMicrosoft 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