Word VBA для решения проблемы разрыва строки или знака абзаца при копировании и вставке в Excel - PullRequest
2 голосов
/ 05 июля 2011

Мне удалось скопировать и вставить таблицу в слово, используя VBA в Excel, но конечный результат не совсем то, что я ожидал.

В некоторых клетках есть проблема с разрывом строки, которую я хотел бы решить.

Например,

У меня есть текст в таблице в слове с определенным переводом строки, например

"Это солнечный день, и у нас есть следующие варианты:"

   a) Go shopping

   b) Stay Indoor

Проблема в том, что после импорта в Excel точки a и b больше не находятся в одной ячейке в Excel. Excel вставил ее как новую ячейку вместо форматирования точек в одну ячейку.

Я пытался использовать поиск и замену, чтобы заменить разрыв строки ^ p на пустое, но буквы a и b будут удалены как пробел. Я не хочу заменять мои a и b как пробел. Мне все еще нужно, чтобы они были вставлены в ячейку Excel.

Sub CreateExcel()

Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim tableWord As Word.Table


Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False

Set xlWB = xlApp.Workbooks.Add ' create a new workbook
'declare the cell to put the text in
With xlWB.Worksheets(1)
     Set tableWord = ActiveDocument.Tables(1)
     tableWord.Range.Copy
    .Paste Destination:=xlWB.Worksheets(1).Range("A1")

    xlApp.Dialogs(xlDialogSaveAs).Show
End With

xlWB.Close False ' close the workbook without saving
xlApp.Quit ' close the Excel application
Set xlWB = Nothing
Set xlApp = Nothing

End Sub

1 Ответ

1 голос
/ 05 июля 2011

Вы можете попытаться найти и заменить на Символ возврата каретки : Chr(10)

[EDIT] Ну, я не могу найти способ разобраться с вашей проблемой, может быть, лучший эксперт VBA найдет решение.

Обходной путь, который я нашел, состоит в объединении значений ячейки после того, как вы вставили их, потому что нет другого способа продолжить форматирование (я адаптировал свой код Excel, чтобы сделать его пригодным для использования в Word vba):

Option Explicit

Sub CreateExcel()

Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim tableWord As Word.Table
Dim cell As Excel.Range, rUsed As Excel.Range, target As Excel.Range
Dim val As String

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
'xlApp.Visible = False

Set xlWB = xlApp.Workbooks.Add ' create a new workbook
'declare the cell to put the text in
With xlWB.Worksheets(1)
     Set tableWord = ActiveDocument.Tables(1)
     tableWord.Range.Copy
    .Paste Destination:=xlWB.Worksheets(1).Range("A1")

    'Select used range to get every cell that was pasted and has content
    Set rUsed = xlWB.Worksheets(1).UsedRange
    Set target = rUsed.Cells(1, 1)
    'Get the value of each cell and concatenate its value
    For Each cell In rUsed
        If cell.Value <> "" Then
            val = val + cell.Value + Chr(10)
            cell.ClearContents
        End If
    Next cell
    'Remove last carriage return
    target.Value = Left(val, Len(val) - 1)

    xlApp.Dialogs(xlDialogSaveAs).Show
End With

xlWB.Close False ' close the workbook without saving
xlApp.Quit ' close the Excel application
Set xlWB = Nothing
Set xlApp = Nothing
End Sub

С уважением,
Max

...