Word VBAで改行または段落記号の問題を解決するときにコピー＆貼り付けをExcelに

Question

VBAを使用してWordで表をコピー＆ペーストできますが、最終結果は期待通りです。

解決したいいくつかのセルに改行の問題があります。例えば

、

私は「これは晴れた日であり、我々は、以下のオプションがあります：」

のような特定の改行と単語のテーブル内のテキストを持っている

a) Go shopping 

    b) Stay Indoor 

この問題は、いったんそれがexcelにインポートされると、aとbがExcelの同じセルに存在しなくなることです。 Excelは、ポイントを単一のセルに書式設定する代わりに、それぞれ新しいセルとして挿入しました。

私はfindとreplaceを使って改行^ 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 

Answer 1

あなたは&がキャリッジリターン文字に置き換える検索しようとすることができます：Chr(10)

[EDIT] まあ、私は、あなたの問題をまっすぐに対処する方法を見つけることができません多分より良いVBAの専門家が解決策を見出すかもしれない。

は、私が見つけたこの問題を回避するには、書式を維持する方法が他にないので、あなたがそれらを貼り付け後の細胞の値を連結することでどちらか（私はWordのVBAでそれを使用可能にするために私のExcelのコードに適応）：

を

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 

よろしく、
マックス