Excel VBA質問箱 IV

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

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


11020 / 13644 ツリー ←次へ | 前へ→

【18608】グラフの大きさの変更 カド 04/10/1(金) 13:02 質問[未読]
【18609】Re:グラフの大きさの変更 Jaka 04/10/1(金) 13:55 回答[未読]
【18612】Re:グラフの大きさの変更 カド 04/10/1(金) 15:09 お礼[未読]
【18616】Re:グラフの大きさの変更 Kein 04/10/1(金) 15:49 回答[未読]
【18618】Re:グラフの大きさの変更 カド 04/10/1(金) 16:21 お礼[未読]
【18610】Re:グラフの大きさの変更 Kein 04/10/1(金) 14:01 回答[未読]
【18613】Re:グラフの大きさの変更 カド 04/10/1(金) 15:15 お礼[未読]

【18608】グラフの大きさの変更
質問  カド  - 04/10/1(金) 13:02 -

引用なし
パスワード
   過去ログに同じ質問がありましたが、うまくいきません。
改めて私の状況において、質問させてください。

以下は、データ範囲を選択して、グラフを描き、グラフの大きさを変更した。
ことを記録したマクロです。

これを実行すると、2度目は("グラフ 61")が無いために、指定した名前のアイテムが
無いというエラーが出ます。

どうすれば、マクロでグラフを描いて大きさも変更することが出来るのでしょうか?

Sub yyy()

  Range("BB6:CF6,BB9:CF11").Select
  Range("BB9").Activate
  Charts.Add
  ActiveChart.ChartType = xl3DColumnStacked
  ActiveChart.SetSourceData Source:=Sheets("新表").Range("BB6:CF6,BB9:CF11")
  ActiveChart.Location Where:=xlLocationAsObject, Name:="新表"
  ActiveChart.Walls.Select
  With ActiveChart
    .Elevation = 15
    .Perspective = 30
    .Rotation = 20
    .RightAngleAxes = True
    .HeightPercent = 100
    .AutoScaling = True
  End With
  ActiveChart.ChartArea.Select
  ActiveSheet.Shapes("グラフ 61").ScaleWidth 1.38, msoFalse, _
    msoScaleFromBottomRight
  ActiveSheet.Shapes("グラフ 61").ScaleHeight 0.53, msoFalse, _
    msoScaleFromBottomRight
End Sub

【18609】Re:グラフの大きさの変更
回答  Jaka  - 04/10/1(金) 13:55 -

引用なし
パスワード
   こんにちは。

Sub yyyw()
  Range("BB6:CF6,BB9:CF11").Select
  Range("BB9").Activate
  Charts.Add
  ActiveChart.ChartType = xl3DColumnStacked
  ActiveChart.SetSourceData Source:=Sheets("新表").Range("BB6:CF6,BB9:CF11")
  ActiveChart.Location Where:=xlLocationAsObject, Name:="新表"
  ActiveChart.Walls.Select
  With ActiveChart
    .Elevation = 15
    .Perspective = 30
    .Rotation = 20
    .RightAngleAxes = True
    .HeightPercent = 100
    .AutoScaling = True
    acn = Mid(.Name, InStr(1, .Name, " ") + 1)
  End With
  ActiveSheet.Shapes(acn).Name = "作ったグラフ"
  ActiveChart.ChartArea.Select
  ActiveSheet.Shapes("作ったグラフ").ScaleWidth 1.38, msoFalse, _
    msoScaleFromBottomRight
  ActiveSheet.Shapes("作ったグラフ").ScaleHeight 0.53, msoFalse, _
    msoScaleFromBottomRight
End Sub

【18610】Re:グラフの大きさの変更
回答  Kein  - 04/10/1(金) 14:01 -

引用なし
パスワード
   シートに埋め込むグラフを作る場合、Charts.Add してから Locationプロパティで
移動するのでなく、直接シートにChartObjectを作った方が何かとやりやすくなります。
即ち

Dim MyCh As ChartObject
Dim PltR As Range
Dim Lp As Single, Tp As Single
Dim Wp As Single, Hp As Single

With Sheets("新表")
  Set PltR = .Range("BB6:CF6, BB9:CF11")
  With .Range("B2").Resize(20, 10)
   Lp = .Left: Tp = .Top: Wp = .Width: Hp = .Height
  End With
  Set MyCh = .ChartObjects.Add(Lp, Tp, Wp, Hp)
End With
With MyCh.Chart
  .ChartType = xl3DColumnStacked
  .SetSourceData PltR

  'その他のプロパティ設定コード
End With
Set PltR = Nothing: Set MyCh = Nothing

というように。

【18612】Re:グラフの大きさの変更
お礼  カド  - 04/10/1(金) 15:09 -

引用なし
パスワード
    ▼Jaka さん 回答ありがとうございます。

私の期待通りうまくいきました。

実は、このグラフをビットマップとしてコピーペイストする必要もありまして、
さらに、グラフをコピペするまでのマクロを記録したものが以下のコードです。
(割愛するとかえって不明点が発生するので全部貼ります)

そうしたところ、今度は("Picture 1242")が含まれるコードとなり、先ほどのグラフを同じように、
マクロの記録ではうまくいかない問題が発生してしまいました。

同じ構文であれば自分で対処するのですが、ちょっと違うので困ってます。
何度も恐縮ですが、お力を貸してください。


Sub Macro733()

  Range("BB9:CF11").Select
  Charts.Add
  ActiveChart.ChartType = xl3DColumnStacked
  ActiveChart.SetSourceData Source:=Sheets("新表").Range("BB9:CF11"), PlotBy:= _
    xlRows
  ActiveChart.Location Where:=xlLocationAsObject, Name:="gurafu"
  With ActiveChart
    .HasAxis(xlCategory) = True
    .HasAxis(xlSeries) = False
    .HasAxis(xlValue) = True
  End With
  ActiveChart.Axes(xlCategory).CategoryType = xlAutomatic
  ActiveChart.Walls.Select
  With ActiveChart
    .Elevation = 15
    .Perspective = 30
    .Rotation = 20
    .RightAngleAxes = True
    .HeightPercent = 100
    .AutoScaling = True
    'グラフの名前”グラフ 99”の1文字目からスペースの次の文字の位置を探して、その位置以降の数字を読み取る
    acn = Mid(.Name, InStr(1, .Name, " ") + 1)
  End With
  
  ActiveSheet.Shapes(acn).Name = "作ったグラフ"
  Selection.ClearFormats
  ActiveChart.Axes(xlValue).MajorGridlines.Select
  Selection.Delete
  ActiveChart.Axes(xlValue).Select
  Selection.Delete
  ActiveChart.Axes(xlCategory).Select
  Selection.Delete
  ActiveChart.Floor.Select
  Selection.ClearFormats
  ActiveChart.Walls.Select
  ActiveChart.ChartArea.Select
  
  With Selection.Border
    .Weight = 2
    .LineStyle = 0
  End With
  
  Selection.Interior.ColorIndex = xlNone
  Sheets("gurafu").DrawingObjects("作ったグラフ").RoundedCorners = False
  Sheets("gurafu").DrawingObjects("作ったグラフ").Shadow = False
  ActiveChart.Walls.Select
  ActiveWindow.Visible = False
  Windows("登録台帳.xls").Activate
  Range("G11").Select
  ActiveSheet.ChartObjects("作ったグラフ").Activate
  ActiveChart.Walls.Select
  ActiveChart.PlotArea.Select
  ActiveChart.ChartArea.Select
  ActiveSheet.Shapes("作ったグラフ").IncrementLeft -208.5
  ActiveSheet.Shapes("作ったグラフ").IncrementTop -167.25
  ActiveSheet.Shapes("作ったグラフ").ScaleWidth 1.69, msoFalse, msoScaleFromTopLeft
  ActiveChart.Legend.Select
  Selection.Delete
  Windows("登録台帳.xls").SmallScroll ToRight:=23
  ActiveChart.Walls.Select
  ActiveChart.PlotArea.Select
  ActiveWindow.Visible = False
  Windows("登録台帳.xls").Activate
  Range("AS6").Select
  ActiveSheet.ChartObjects("作ったグラフ").Activate
  ActiveChart.SeriesCollection(3).Select
  ActiveChart.Floor.Select
  ActiveChart.PlotArea.Select
  ActiveChart.ChartArea.Select
  ActiveWindow.Visible = False
  Windows("登録台帳.xls").Activate
  Range("AS29").Select
  ActiveSheet.ChartObjects("作ったグラフ").Activate
  ActiveChart.Floor.Select
  Windows("登録台帳.xls").LargeScroll ToRight:=-1
  ActiveWindow.Visible = False
  Windows("登録台帳.xls").Activate
  Range("L3").Select
  ActiveSheet.ChartObjects("作ったグラフ").Activate
  ActiveChart.SeriesCollection(3).Select
  Windows("登録台帳.xls").SmallScroll ToRight:=10
  ActiveChart.SeriesCollection(3).Points(1).Select
  ActiveChart.SeriesCollection(3).Points(2).Select
  ActiveChart.SeriesCollection(3).Points(3).Select
  ActiveChart.SeriesCollection(3).Points(4).Select
  ActiveChart.SeriesCollection(3).Points(5).Select
  ActiveChart.SeriesCollection(3).Points(6).Select
  ActiveChart.SeriesCollection(3).Points(7).Select
  ActiveChart.SeriesCollection(3).Points(8).Select
  ActiveChart.SeriesCollection(3).Points(9).Select
  ActiveChart.SeriesCollection(3).Points(10).Select
  ActiveChart.SeriesCollection(3).Points(11).Select
  ActiveChart.SeriesCollection(3).Points(12).Select
  ActiveChart.SeriesCollection(3).Points(13).Select
  ActiveChart.SeriesCollection(3).Points(14).Select
  ActiveChart.SeriesCollection(3).Points(15).Select
  ActiveChart.SeriesCollection(3).Points(16).Select
  ActiveChart.ChartArea.Select
  ActiveChart.PlotArea.Select
  ActiveChart.Floor.Select
  ActiveChart.Walls.Select
  ActiveChart.Corners.Select
  ActiveChart.SeriesCollection(1).Select
  ActiveChart.SeriesCollection(1).Points(1).Select
  ActiveChart.SeriesCollection(1).Points(2).Select
  ActiveChart.SeriesCollection(1).Points(3).Select
  ActiveChart.SeriesCollection(1).Points(4).Select
  ActiveChart.SeriesCollection(1).Points(5).Select
  ActiveChart.SeriesCollection(1).Points(6).Select
  ActiveChart.SeriesCollection(1).Points(7).Select
  ActiveChart.SeriesCollection(1).Points(8).Select
  ActiveChart.SeriesCollection(1).Points(9).Select
  ActiveChart.SeriesCollection(1).Points(10).Select
  ActiveChart.SeriesCollection(1).Points(11).Select
  ActiveChart.SeriesCollection(1).Points(12).Select
  ActiveChart.SeriesCollection(1).Points(13).Select
  ActiveChart.SeriesCollection(1).Points(14).Select
  ActiveChart.PlotArea.Select
  ActiveWindow.Visible = False
  Windows("登録台帳.xls").Activate
  Range("AS28").Select
  ActiveSheet.ChartObjects("作ったグラフ").Activate
  ActiveChart.Floor.Select
  ActiveChart.PlotArea.Select
  ActiveChart.ChartArea.Select
  ActiveSheet.Shapes("作ったグラフ").IncrementLeft 476.25
  ActiveSheet.Shapes("作ったグラフ").IncrementTop -22.5
  ActiveSheet.Shapes("作ったグラフ").IncrementLeft 986.25
  ActiveSheet.Shapes("作ったグラフ").IncrementTop -12#
  
  Windows("登録台帳.xls").SmallScroll ToRight:=13
  ActiveChart.PlotArea.Select
  ActiveChart.ChartArea.Select
  ActiveSheet.Shapes("作ったグラフ").IncrementLeft 210#
  ActiveSheet.Shapes("作ったグラフ").IncrementTop -12#
  
  ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:= _
    xlBitmap
    
  Windows("登録台帳.xls").LargeScroll ToRight:=-1
  ActiveWindow.Visible = False
  Windows("登録台帳.xls").Activate
  Range("M6:M9").Select
  
  ActiveSheet.Paste
  Selection.ShapeRange.ScaleHeight 0.15, msoFalse, msoScaleFromTopLeft
  Range("G9").Select
  
  ActiveWindow.SmallScroll ToRight:=8
  ActiveSheet.Shapes("Picture 1242").Select
  
  Selection.ShapeRange.ScaleWidth 1.04, msoFalse, msoScaleFromBottomRight
  Selection.ShapeRange.ScaleWidth 1.01, msoFalse, msoScaleFromBottomRight
  Selection.ShapeRange.ScaleWidth 0.99, msoFalse, msoScaleFromTopLeft
  Selection.ShapeRange.ScaleWidth 0.99, msoFalse, msoScaleFromTopLeft
  Selection.ShapeRange.IncrementTop 1.5
  Selection.ShapeRange.IncrementTop 1.5
  Selection.ShapeRange.IncrementTop 2.25
  Selection.ShapeRange.IncrementTop 1.5
  Range("AT2").Select
  ActiveSheet.Shapes("Picture 1242").Select
  Selection.ShapeRange.PictureFormat.TransparentBackground = msoTrue
  Selection.ShapeRange.PictureFormat.TransparencyColor = RGB(255, 255, 255)
  Selection.ShapeRange.Fill.Visible = msoFalse
  Range("AT2").Select
End Sub

【18613】Re:グラフの大きさの変更
お礼  カド  - 04/10/1(金) 15:15 -

引用なし
パスワード
   ▼Kein さん 回答ありがとうございます。

言われている趣旨は判りました。
今回は急ぎの業務に直結した質問のため、マクロの記録のままでの
コードのほうが実用性が高く、ご回答いただいたコードは
あとでゆっくり勉強させていただきます。

【18616】Re:グラフの大きさの変更
回答  Kein  - 04/10/1(金) 15:49 -

引用なし
パスワード
   グラフでも図形でも、作った直後はIndexが一番最後になります。
それを利用して

With ActiveSheet
  Set Ch = .ChartObjects(.ChartObjects.Count)
  '↑グラフの場合
  Set Pic = .Pictures(.Pictures.Count)
  '↑画像の場合
End With

などとしてしまえば良いのです。何度も ActiveChart.〜 などとするのは
効率が悪いから止めましょう。

【18618】Re:グラフの大きさの変更
お礼  カド  - 04/10/1(金) 16:21 -

引用なし
パスワード
   ▼Kein さん 回答ありがとうございます。

教えていただいた方法でオブジェクトを指定することが出来るようになりました。
これで何とかなりそうです。

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