エクセルとワードの連携による成績表データのレイアウト処理方法

質問

• エクセルとワードを連携させることで、成績表データを効率的にワードに表示させる方法をご紹介します。
• 現在はエクセルでのソートのマクロを使用していますが、その後のレイアウト処理は手作業で行っています。
• エクセルとワードを連携させることで、エクセルでのソートした結果を自動的にワードに表示させ、レイアウト処理を効率化することが可能です。

回答No.4

Wendy02 · ベストアンサー

位置等は分かりませんから、あくまでもサンプルとして出しておきます。連結は、オートメーションにしました。挿し込みのODBCは並べ替えには、Queruを作らなくてはなりませんが、私は、詳しくありません。また、ExcelからWordをコントロールするよりも、Wordからのほうが楽です。

以下は、Wordマクロですが、実際のWordファイルの標準モジュールか、ThisDocument に登録してお使いください。なお、TextBox は、オートシェイプであること。
ブック名とシートは予め登録してください。TextBox の数と、取得するシートは数を合わせてください。参考にしてみてください。

'//
Sub GetExcelData()
　'設定 (* は、ユーザー設定可能）
　Const xlFNAME = "myBook1.xlsx" '*
　Const xlSHNAME = "Sheet1,Sheet2,Sheet3" '*スペースは入れないで、カンマで区切る
'---------------
　Dim arSheets As Variant
　Dim xlPath As String, xlApp As Object
　Dim xlBk As Object, xlSh As Object, sh As Variant, Ar() As Variant
　Dim rng As Object, t As Variant, a As String, cnt As Integer
　Dim i As Long, j As Long, k As Long
　Dim ctrl As Object
　Const xlTop10Items As Integer = 3
　arSheets = Split(xlSHNAME, ",")
　On Error GoTo ErrHandler
　Set xlApp = CreateObject("Excel.Application")
　With xlApp
　　xlPath = .DefaultFilePath '*Excelのバス（現在はデフォルトパス）
　　'.Visible = True '*ブックを表示する（ブロックは非表示）
　　Set xlBk = .Workbooks.Open(xlPath & xlFNAME)
　End With

　For Each sh In arSheets
　　Set xlSh = xlBk.Worksheets(sh)
　　xlSh.AutoFilterMode = False
　　Set rng = xlSh.Range("A1").CurrentRegion
　　'オートフィルタはA1からで、2列目で順位を決めている
　　rng.AutoFilter Field:=2, Criteria1:="3", Operator:=xlTop10Items '*
　　With rng
　　　For i = 2 To .Rows.Count
　　　　If .Cells(i, 1).EntireRow.Hidden = False Then
　　　　　t = xlApp.Transpose(.Rows(i).Value)
　　　　　t = xlApp.Transpose(t)
　　　　　t = Join(t, Space(1))
　　　　　a = a & vbCrLf & t
　　　　　cnt = cnt + 1
　　　　End If
　　　　If cnt > 3 Then Exit For '3列取得したら離脱
　　　Next i
　　End With
　　ReDim Preserve Ar(k)
　　Ar(k) = Replace(a, vbCrLf, "", , 1)
　　a = ""
　　k = k + 1: Set rng = Nothing: cnt = 0
　Next sh
　xlBk.Close False
　For Each ctrl In ActiveDocument.Shapes
　　If ctrl.Type = msoTextBox Then
　　　ctrl.TextFrame.TextRange.Text = Ar(j)
　　　j = j + 1
　　　Beep　'* ビープ音
　　End If
　　If j >= k Then Exit For
　Next ctrl
ErrHandler:
　Set xlBk = Nothing: Set xlSh = Nothing: Set rng = Nothing
　xlApp.Quit
　Set xlApp = Nothing
　ActiveDocument.Activate
End Sub

お礼

Wendy02　様　ありがとうございました。
大雑把な質問にもかかわらず具体的にマクロをご紹介頂き痛み入ります。
勉強しながら大切に使わせていただきます。
簡単で恐縮ですが、お礼申し上げます。