Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


37184 / 76732 ←次へ | 前へ→

【44721】Re:成績表にグラフを入れるマクロ
発言  ichinose  - 06/11/29(水) 23:46 -

引用なし
パスワード
   こんばんは。
どうして、生徒の数だけグラフオブジェクトを作るのですか?
印刷が目的なら印刷用レイアウトシートにグラフオブジェクトはひとつ作成すれば
良いと思いますが・・・。
生徒氏名と得点だけ差し込むだけで足りると思いますよ!!

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

これで上記の生徒の成績表を個別に印刷できます。

私は、説明の都合上、動的に差込シート(グラフのあるシート)を作成しましたが、

これは予め準備しておいても良いと思います。
(実際にやるなら、私はそうします)
試してみてください。
2 hits

【44686】成績表にグラフを入れるマクロ オイスター 06/11/28(火) 21:23 質問
【44688】Re:成績表にグラフを入れるマクロ maverick 06/11/28(火) 23:07 回答
【44718】Re:成績表にグラフを入れるマクロ オイスター 06/11/29(水) 20:21 質問
【44720】Re:成績表にグラフを入れるマクロ maverick 06/11/29(水) 22:52 回答
【44721】Re:成績表にグラフを入れるマクロ ichinose 06/11/29(水) 23:46 発言
【44763】Re:成績表にグラフを入れるマクロ オイスター 06/11/30(木) 21:07 お礼

37184 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free