Использование PowerPoint VBA для открытия файла CSV в Excel

Question

Я пытаюсь написать приложение PowerPoint VB, которое должно отображать определенные значения из текстового файла в фиксированном формате.

Когда я (вручную) открываю этот текстовый файл как файл CSV в Excel, яполучить необходимые значения в фиксированных ячейках, и я знаю, как продолжить от VBA.

Что я не знаю, как создать электронную таблицу Excel с помощью макроса в PowerPoint.Кроме того, я хочу убедиться, что параметры для открытия файла (используя пробел в качестве разделителя; несколько пробелов считаются за один) определены в макросе, поэтому мне не нужно полагаться на текущие локальные настройки.

Заранее спасибо за любую идею или ссылку.

Answer 1

1. используйте ~ .OpenText, он поддерживает последовательный разделитель

2.Используйте текстовый файл не с расширением .csv, а с расширением .txt. Excel не может загрузить текст с другим разделителем, если его расширение'.csv'

Следующий макрос читает текстовый файл с разделителями пробела и копирует таблицу Excel в таблицу Powerpoint на слайде.

Полный код:

Sub ReadCSV()

Dim xlsApp As Excel.Application
Dim xlsWb As Excel.Workbook
Dim xlsSht As Object        'Excel.Worksheet
Dim rng As Object           'Excel.Range
Dim Target As String

On Error GoTo Oops
'Set xlsApp = New Excel.Application
Set xlsApp = CreateObject("Excel.Application")
xlsApp.Visible = True

Target = ActivePresentation.Path & "\test_space.txt"

'Below don't support consecutive delimiters
'Set xlsWb = xlsApp.Workbooks.Open(FileName:=Target, Format:=3)

'File Extension .CSV won't work here. .TXT works.
xlsApp.Workbooks.OpenText FileName:=Target, Origin:=2, StartRow:=1, _
    DataType:=1, ConsecutiveDelimiter:=True, Space:=True, Local:=True
Set xlsWb = xlsApp.ActiveWorkbook
Set xlsSht = xlsWb.Worksheets(1)

Dim sld As Slide
Dim shp As Shape
Dim tbl As Table
Dim numRow As Long, numCol As Long
Dim r As Long, c As Long

Set rng = xlsSht.UsedRange
    numRow = rng.Rows.Count
    numCol = rng.Columns.Count

With ActivePresentation
    Set sld = .Slides.Add(.Slides.Count + 1, ppLayoutBlank)
End With
Set shp = sld.Shapes.AddTable(numRow, numCol, 100, 100, 200, 150)
shp.Name = "Table"
Set tbl = shp.Table

'Copy cell values from Excel Table to Powerpoint Table
For r = 1 To numRow
    For c = 1 To numCol
        tbl.Cell(r, c).Borders(ppBorderBottom).ForeColor.RGB = rgbBlack
        With tbl.Cell(r, c).Shape.TextFrame
            If r > 1 Then .Parent.Fill.ForeColor.RGB = rgbWhite
            .VerticalAnchor = msoAnchorMiddle
            .TextRange = rng.Cells(r, c)
            .TextRange.ParagraphFormat.Alignment = ppAlignCenter
        End With
    Next c
Next r

xlsWb.Close False

Oops:
If Err.Number Then MsgBox Err.Description
'If Excel App remains in the system process, Excel App won't respond and run again.
If Not xlsApp Is Nothing Then xlsApp.Quit: Set xlsApp = Nothing

End Sub