Excel VBA質問箱 IV

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

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


37185 / 76732 ←次へ | 前へ→

【44720】Re:成績表にグラフを入れるマクロ
回答  maverick  - 06/11/29(水) 22:52 -

引用なし
パスワード
   ▼オイスター さん:
>maverick さん
>
>お返事が大変遅くなってしまい申し訳ありません。さらに一つ教えて頂きたいことが出てまいりました。maverickさんの教えてくださった一番最初のプログラムで試してみたのですが、とりあえず思った通りに動きました。しかし一番最後の成績表に貼り付けられたグラフの裏には前の二人分のグラフが重なって残っていました。これは仕方がないことなのでしょうか?消すことはできないのでしょうか?印刷マクロも組み込みますので、特に影響はないと思われますが、気になったらどうしようもありませんので、質問させて頂きました。よろしくお願いします。
>
消すだけならループを使わなければいいだけです。

重なってしまっているのはオイスター さんのコードがそうなっているからですよ!
>For k = 2 To 4
〜中略〜
>  ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet2"
〜中略〜
>Next k
ループの中で作成される全てのグラフが"Sheet2"に作成されています。
シートを別にするか、グラフ位置をズラしてやる必要があります。

サンプルは試してみましたか?
サンプルでは

・人数分ループ
>  For k = 2 To Range("A65536").End(xlUp).Row
・シートが足りない場合は追加
>    If k > Worksheets.Count Then
>      Worksheets.Add After:=Worksheets(k - 1)
>      ActiveSheet.Name = "Sheet" & k
>    End If
・kに対応するシートにグラフを作成
>      .Location Where:=xlLocationAsObject, Name:="Sheet" & k

という仕様になっています。


ついでに、少し整形処理を加えたものを

Sub test()
  Dim k As Long, i As Integer
  Dim msht As Worksheet
  Dim csht As Worksheet

  Application.ScreenUpdating = False
  Set msht = Sheets("Sheet1")
  For k = 2 To msht.Range("A65536").End(xlUp).Row
    If k > Worksheets.Count Then
      Set csht = Worksheets.Add(After:=Worksheets(k - 1))
      csht.Name = "Sheet" & k
    Else
      Set csht = Sheets("Sheet" & k)
    End If
    With csht
      .Range("B5").Value = msht.Range("A1").Value
      .Range("C5").Value = msht.Range("A" & k).Value
      Call SetRng(.Range("B5:C5"))
      .Range("B8").Resize(, 3).Value = msht.Range("B1").Resize(, 3).Value
      For i = 2 To 4
        .Cells(9, i).Value = msht.Cells(k, i).Value & "点"
      Next i
      Call SetRng(.Range("B8:D9"))
      .ChartObjects.Delete
    End With
    With csht.ChartObjects.Add(300, 50, 200, 200).Chart
      .ChartType = xlRadarMarkers
      .SetSourceData Source:=msht.Range(msht.Cells(k, 2), msht.Cells(k, 4)), PlotBy:=xlRows
      .SeriesCollection(1).XValues = "=Sheet1!R1C2:R1C4"
      .Location Where:=xlLocationAsObject, Name:="Sheet" & k
      .Axes(xlValue).MaximumScale = 100
      .Axes(xlValue).MajorUnit = 25
      .HasLegend = False
    End With
    csht.Range("A1").Activate
    Set csht = Nothing
  Next k
  msht.Activate
  Set msht = Nothing
  Application.ScreenUpdating = False
End Sub

Function SetRng(rng As Range)
  With rng
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    If .Rows.Count > 1 Then
      .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End If
    If .Columns.Count > 1 Then
      .Borders(xlInsideVertical).LineStyle = xlContinuous
    End If
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Font.Size = 12
  End With
End Function
1 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 お礼

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