vba读取txt文档指定列至Word中，并按照12*8的矩阵排列。求高人帮助。

附件

vba求助.rar(23.71 KB)

2011-1-7 11:12, 下载次数: 1

VBA求助

复制内容到剪贴板

代码:

Sub test()
    Dim fs, f, aCell As Cell, myShape As Shape
    Dim l As Single, t As Single, w As Single
    Dim info() As String, i As Integer, a As String
   
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "请指定数据源文本文件"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set f = fs.OpenTextFile(.SelectedItems(1), 1, -1)
    End With
    info = Split(f.readall, vbCrLf)
    w = ActiveDocument.InlineShapes(1).Width
    Application.ScreenUpdating = False
   
    For Each aCell In ActiveDocument.Tables(1).Range.Cells
        If i > UBound(info) Then Exit For
        If aCell.Range.InlineShapes.Count = 1 Then
            i = i + 1
            l = aCell.Range.Characters.First.Information(wdHorizontalPositionRelativeToTextBoundary)
            t = aCell.Range.Characters.First.Information(wdVerticalPositionRelativeToTextBoundary) + 2  ''微调文本框垂直位置
            Set myShape = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, l, t, w, w, aCell.Range.Characters.First)
            myShape.Fill.Visible = msoFalse
            myShape.Line.Visible = msoFalse
            a = Split(info(i), Chr(9))(0)  ''提取数据
            a = Mid(a, 2, Len(a) - 2)
            With myShape.TextFrame.TextRange  ''插入提取到的文本，并设置段落格式和字符大小
                .Text = a
                With .ParagraphFormat
                    .SpaceBefore = 5
                    .LineSpacingRule = wdLineSpaceExactly
                    .LineSpacing = 9
                    .Alignment = wdAlignParagraphCenter
                End With
                .Font.Size = 7
            End With
        End If
    Next
    MsgBox "处理完毕! 共导入了 " & i & "个数据。"
    Application.ScreenUpdating = True
End Sub