こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルとワードの連携

こんにちは いつもお世話になっています

エクセル(2007)に成績表データがあります。人名、クラス、教科の項目です。
ここから、教科ごとにクラス別の上位3位までをワード(2007)のテキストボックス(複数)に入力して印刷用にレイアウト調整しています。
ここで漠然とした質問になりますがアイデアで構いませんのでお願いします。
エクセルの表から、特定データをレイアウト処理用にワードに持ってくる際の効率的な方法を教えてください。
現在の自動化部分はエクセルでのソートのマクロだけで、その後は手作業でワードの複数テキストボックスへの貼り付けをしています。
素人考えでは、例えばエクセルとワードを連携させてエクセルでソートしただけで、ワードに上位3位までを表示させ、その後レイアウト処理を手動でできないかと思っています。
関連情報でも構いません。よろしくお願いします。

投稿日時 - 2011-02-19 11:53:01

QNo.6534298

すぐに回答ほしいです

質問者が選んだベストアンサー

位置等は分かりませんから、あくまでもサンプルとして出しておきます。連結は、オートメーションにしました。挿し込みの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

投稿日時 - 2011-02-19 18:11:39

お礼

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

投稿日時 - 2011-02-20 10:30:09

ANo.4

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.3

差し込み印刷でも可能と思いますがWordとの連携の例は
Word文書の特定部分を
Excelに記録されている文字列で置き換える代物ですが・・・

投稿日時 - 2011-02-19 15:10:15

お礼

yy_kd 様 ありがとうございました。
アイデアをご紹介頂き助かりました。
試してみます。
簡単で恐縮ですが、お礼申し上げます。

投稿日時 - 2011-02-20 10:25:50

ANo.2

質問のテーマなら「差込印刷」を使えるのでは。
ワードの常識、「差込印刷」のことが1言も出てこないのは知らないから?
「差込印刷」だけをテーマにした、単行本も市販されています。詳しくは勉強してください。
Googleででも「差込印刷」「差(し)込み印刷}で照会すれば、解説が多数有る。
ーー
上位者を抜き出す方法はエクセル関数でも出来なくは無いが、フィルタがお奨め。
質問振りから、これも使ってないのでは。
データーフィルターオプションートップテンートップ3位に変更ーOK
例データ
氏名点数
a23
b45
c65
d78
e54
f65
マクロなら(マクロの記録で判るが)
Sub Macro3()
Range("A1:B7").AutoFilter Field:=2, Criteria1:="3", Operator:=xlTop10Items
End Sub
ーー
結果
氏名点数
c65
d78
f65
編集ージャンプーセル選択ー可視セルーOK
別シートなどに貼り付け。

投稿日時 - 2011-02-19 12:24:29

お礼

imogasi 様 ありがとうございました。
差し込み印刷、フィルタを知りませんでした。
ご紹介頂き助かりました。試してみます。
簡単で恐縮ですが、お礼申し上げます。

投稿日時 - 2011-02-20 10:23:41

ANo.1

ご希望の操作は、単純にリンク貼り付けでできそうです。

エクセルのセルを選択し「コピー」、ワードのテキストボックスにカーソルを置いて、ホームタブの「貼り付け」をクリックして「形式を選択して貼り付け」で「テキスト」を選択して「リンク貼り付け」して下さい。

投稿日時 - 2011-02-19 12:18:04

お礼

MackyNo1 様 ありがとうございました。
リンク貼り付けを知りませんでした。
大変勉強になりました。試してみます。
簡単で恐縮ですが、お礼申し上げます。

投稿日時 - 2011-02-20 10:20:19

あなたにオススメの質問