|
こんばんは。
どうして、生徒の数だけグラフオブジェクトを作るのですか?
印刷が目的なら印刷用レイアウトシートにグラフオブジェクトはひとつ作成すれば
良いと思いますが・・・。
生徒氏名と得点だけ差し込むだけで足りると思いますよ!!
Sheet1というシートに以下の成績データがあるとします。
A B C D
1 氏名 国語 英語 社会
2 A 30 77 40
3 B 47 72 36
4 C 26 33 51
この表を個人別成績表にして印刷することを考えます。
標準モジュールに
'===========================================================
Sub sample()
Dim idx As Long
Dim rw As Long
Dim rng As Range
Dim sht As Worksheet
With Worksheets("sheet1")
Set sht = Workbooks.Add.ActiveSheet
Set rng = mk_print_area(sht)
sht.Activate
rng.Select
rw = .Cells(.Rows.Count, 1).End(xlUp).Row
For idx = 2 To rw
rng.Value = .Range(.Cells(idx, 1), .Cells(idx, 4)).Value
sht.PrintOut
Next idx
End With
sht.Parent.Close False
End Sub
'======================================================================
Function mk_print_area(sht As Worksheet) As Range
Dim locate As Variant
With sht
.Rows("4:7").RowHeight = 27
With .Range("b4")
.Value = "模擬試験成績表"
End With
.Columns("B:B").ColumnWidth = 28.75
With .Range("B6:e7")
.Rows(1).Value = Array("氏名", "国語", "英語", "社会")
For Each locate In Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight, xlInsideVertical, xlInsideHorizontal)
With .Borders(locate)
.LineStyle = xlNone
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Next
.Rows(2).Value = Array("dummy", 100, 100, 100)
End With
With .Parent.Charts.Add
.ChartType = xlRadar
.SetSourceData Source:=sht.Range("C6:E7"), PlotBy:=xlRows
.SeriesCollection(1).Name = "=" & sht.Name & "!r7c2"
With .Location(Where:=xlLocationAsObject, Name:=sht.Name)
.Parent.Left = sht.Range("b10").Left
.Parent.Top = sht.Range("b10").Top
.Parent.Width = sht.Range("b10:e10").Width
End With
End With
.Range("b7:e7").ClearContents
Set mk_print_area = .Range("b7:e7")
End With
End Function
これで上記の生徒の成績表を個別に印刷できます。
私は、説明の都合上、動的に差込シート(グラフのあるシート)を作成しましたが、
これは予め準備しておいても良いと思います。
(実際にやるなら、私はそうします)
試してみてください。
|
|