2017-12-08 12 views
0

ブック(すべてのシート)を1つのWord文書として保存します。 1枚はドキュメントの1ページです。Excel VBA:ブックをWord文書として保存します。

私はアクティブシートを保存するためのコードしか見つかりません。

Sub ExcelToWord() 
Dim ws As Worksheet 
Set ws = ActiveSheet 
Dim objWd As Object 
Set objWd = CreateObject("word.application") 
objWd.Visible = True 
Dim objDoc As Object 
Set objDoc = objWd.Documents.Add 
objDoc.PageSetup.Orientation = 1 ' portrait = 0 
Application.ScreenUpdating = False 
ws.UsedRange.Copy 
objDoc.Content.Paste 
Application.CutCopyMode = False 
Application.DisplayAlerts = False 
objDoc.SaveAs (Application.ThisWorkbook.Path & "\dokument.docx") 
Application.DisplayAlerts = True 
Application.ScreenUpdating = True 
End Sub 

ご返信ありがとうございます。

+2

コードだけ保存を行う前に、コピー/貼り付けを行っている各ワークシート経由のコピー/貼り付けを行って、これだけループしているようです。 – YowE3K

+0

はい、同じと思いますが、スクリプトは最後のページ(シート)のみを保存します。 n = Sheets.Count i = 1 To nについて シート(i).UsedRange.Copy objDoc.Content.Paste 次へ –

答えて

1

いくつかの簡単なことが解決策につながります。

最初は、ブック内のワークシートをループにある、次のように:

Dim ws As Worksheet 
For Each ws in ThisWorkbook.Sheets 
    Debug.Print "The used range is " & ws.UsedRange.Address 
Next ws 

次の部分は、Word文書にコンテンツを追加することが実現されどのように理解することです。主なコンセプトには、ドキュメントの挿入ポイントがどこにあるかが含まれます。一般的に、これは現在のSelectionです。

Word文書に切り取って貼り付けると、貼り付けたコンテンツはまだ「選択済み」です。これは、その後のペーストが、挿入したばかりのものを効果的に置き換えることを意味します。したがって、選択ポイントをドキュメントの最後に移動する必要があります。プログラム例ではすべて一緒にそれを置く

Option Explicit 

Public Sub ExcelToWord() 
    Dim wb As Workbook 
    Set wb = ThisWorkbook 

    '--- create the Word document 
    Dim objWd As Word.Application 
    Set objWd = CreateObject("word.application") 
    objWd.Visible = True 

    Dim objDoc As Word.Document 
    Set objDoc = objWd.Documents.Add 
    objDoc.PageSetup.Orientation = 1    ' portrait = 0 

    Const wdPageBreak As Long = 7 

    Dim ws As Worksheet 
    For Each ws In wb.Sheets 
     ws.UsedRange.Copy 
     objWd.Selection.Paste 
     '--- advance the selection point to the end of 
     ' the document and insert a page break, then 
     ' advance the insertion point past the break 
     objDoc.Characters.Last.Select 
     objWd.Selection.InsertBreak wdPageBreak 
     objDoc.Characters.Last.Select 
    Next ws 
    'objDoc.SaveAs Application.ThisWorkbook.Path & ".\dokument.docx" 
End Sub 
関連する問題