位置等は分かりませんから、あくまでもサンプルとして出しておきます。連結は、オートメーションにしました。挿し込みの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
質問のテーマなら「差込印刷」を使えるのでは。
ワードの常識、「差込印刷」のことが1言も出てこないのは知らないから?
「差込印刷」だけをテーマにした、単行本も市販されています。詳しくは勉強してください。
Googleででも「差込印刷」「差(し)込み印刷}で照会すれば、解説が多数有る。
ーー
上位者を抜き出す方法はエクセル関数でも出来なくは無いが、フィルタがお奨め。
質問振りから、これも使ってないのでは。
データーフィルターオプションートップテンートップ3位に変更ーOK
例データ
氏名 点数
a 23
b 45
c 65
d 78
e 54
f 65
マクロなら(マクロの記録で判るが)
Sub Macro3()
Range("A1:B7").AutoFilter Field:=2, Criteria1:="3", Operator:=xlTop10Items
End Sub
ーー
結果
氏名 点数
c 65
d 78
f 65
編集ージャンプーセル選択ー可視セルーOK
別シートなどに貼り付け。
お礼
Wendy02 様 ありがとうございました。 大雑把な質問にもかかわらず具体的にマクロをご紹介頂き痛み入ります。 勉強しながら大切に使わせていただきます。 簡単で恐縮ですが、お礼申し上げます。