Results of 1 - 1 of about 3686 for グラフ (0.002 sec.)
- [[20100324114103]]
- #score: 3272
- @digest: 3c2ec1109ef9be2114ba10c831378571
- @id: 48471
- @mdate: 2010-03-31T07:34:10Z
- @size: 21863
- @type: text/plain
- #keywords: plotarea (83745), objarea (69558), フ") (46921), axistitle (45438), ク": (40327), autoscalefont (37410), xlvalue (37139), フ範 (36971), axes (28839), xlcategory (24022), chartarea (22551), newseries (21537), mychart (16913), seriescollection (13757), ラフ (11088), border (10999), charttype (10513), 数+ (10418), 囲. (10330), グラ (10241), 数/ (9351), 数時 (8729), vbcancel (7309), activechart (7249), 囲= (7178), 整数 (6611), vbokcancel (6429), ゴシ (6256), 始行 (5872), height (5689), シッ (5134), characters (4876)
- 『グラフのプロットエリアを任意のセルに合わせたい』（まき）
Excel2003, Vista いつも色々参考にさせて頂いております。 さて、現在4軸のグラフをマクロで作ろうとしており、1軸で2〜4軸を変数変換させて グラフは問題無く出来ました。2〜4軸を1軸の左側に項目名と出したと考えており、 その為にPlotAreaをセルに合わせたいと色々行っていますが、上手に出来ないのでご伝授 をお願い致します。過去に有った http://www.excel.studio-kazu.jp/kw/20050725174254.html を参考にChartエリアはセルに合わせて出来ました。分かりやすい様にシートのrowを15に 設定して.PlotArea.Topを色々変えてみましたが、どうしてもセルに合いません。出来れば、 PlotArea.Height(Y軸)を8セル(15*8=120)にしたいのですが、こっちを直すと下がずれた りで、お手上げ状態です。ちなみに現行のVBAは(抜粋)は次の通りです。複数個のグラフを を1度に書くので、奇数時には左側、偶数値には右側と配置する様にしました。 ---------------(上記省略)------------- Sheets("グラフ").Activate If 回数 Mod 2 <> 0 Then '奇数時 整数 = Application.RoundUp(回数 / 2, 0) + Application.RoundDown(回数 / 2, 0) * 21 + 1 Set グラフ範囲 = Sheets("グラフ").Range("J" & 整数 & ":N" & 整数 + 20) Else '偶数時 整数 = Application.RoundUp(回数 / 2, 0) + (Application.RoundUp(回数 / 2, 0) - 1) * 21 + 1 Set グラフ範囲 = Sheets("グラフ").Range("X" & 整数 & ":AB" & 整数 + 20) End If Set グラフChart = Sheets("グラフ").ChartObjects.Add( _ グラフ範囲.Left, グラフ範囲.Top, グラフ範囲.Width, グラフ範囲.Height) With グラフChart.Chart .ChartType = xlLine 'グラフの種類 .SetSourceData Source:=Sheets("temp").Range(ラベル範囲, "F" & 始行 + 1 & _ ":" & 完了 & 最終行 & ""), PlotBy:=xlColumns .SeriesCollection(1).XValues = x軸 .PlotArea.Top = 160 'プロットエリアの上の位置 .PlotArea.Width = 240 '1列あたり、約80 .PlotArea.Height = 144 '1rowあたり、15ピクセル .PlotArea.Border.Weight = 2 .PlotArea.Border.LineStyle = 0 .PlotArea.Interior.ColorIndex = xlNone ---------------(以下省略)------------- お手数ですが、よろしくお願い申し上げます。 ---- なかなか解答がつかないようですが...。 と言うのも、コードだけ記載されても、同じように再現できないからだと思います。 元のグラフのデータレイアウトなどとともに、どの種類のグラフなのか等も記載されると、 見ている人も再現できるのではなかろうか? と思います。 ほとんど山勘な上、確認とってませんが。 （確認を取っていないと言うより、なさりたい事が解ってません。） プロットエリアでなく、図形としてのグラフで扱ったらどうでしょうか? グラフをマウスで選択した時に、黒い四角点で選択表示されるのではなく、 白い丸点で、選択表示されるオブジェクトの事。 （図形描画ツールバーの左の方にある、左斜め上の矢印アイコンで （グラフを選択した時のオブジェクト。） 表現が難しいのでこんな表現になってます。 BJ ---- ---- >コードだけ記載されても、同じように再現できないからだと思います。 正にこれが大きい原因ですね!! 私は、グラグはあまり使わないので簡単なグラフで試して見ました。 新規ブックにて試してみてください。 標準モジュールに '===================================================================================== Sub sample() Dim obj As Range Dim plot As Range Set obj = Range("a10:j23") Set plot = Range("b12:i20") Call mk_sample_data Rows("1:30").RowHeight = 15 Columns("A:M").ColumnWidth = 9 MsgBox "ご覧のデータでグラフを" & obj.Address & "に又、グラグ軸を" & plot.Address & "のセル範囲にあわせて作成します" Call mk_graph(Range("a1:b8"), obj, plot) End Sub '===================================================================================== Sub mk_sample_data() Range("a1:b8").Value = Evaluate("{""氏名"",""身長(Cm)"";""a"",140;""b"",145;" & _ """c"",135;""d"",130;""e"",160;""f"",155;""g"",170}") End Sub '====================================================================================== Sub mk_graph(ByVal c_dataarea As Range, ByVal c_objarea As Range, c_plotarea As Range) Dim mychart As Chart Dim ll As Double Dim hh As Double ll = c_plotarea.Left - c_objarea.Left hh = c_plotarea.Top - c_objarea.Top Application.Goto c_objarea c_objarea.Select With Charts.Add .ChartType = xlColumnClustered .SetSourceData Source:=c_dataarea, PlotBy:=xlColumns Set mychart = .Location(Where:=xlLocationAsObject, Name:=c_objarea.Parent.Name) With mychart.Parent .Left = c_objarea.Left .Top = c_objarea.Top .Width = c_objarea.Width .Height = c_objarea.Height End With With mychart.PlotArea .Left = 0 .Top = 0 .Width = c_plotarea.Width .Width = .Width + .Width - .InsideWidth .Height = c_plotarea.Height .Height = .Height + .Height - .InsideHeight .Left = ll + .Left - .InsideLeft - mychart.ChartArea.Left .Top = hh - .InsideTop + .Top - mychart.ChartArea.Top End With End With End Sub sampleを実行してみてください。 作成されたデータに対して、コードで表示されるようなグラフを作成します。 尚、plotというセル範囲に対して、十分余裕のあるobjというセル範囲を指定しないと 正しく作成されないので注意してください（単純にセル範囲が obj>=plotでは駄目な場合がありました） 大勢の方に考えてもらうには、サンプルが必要なのでこれを足がかりにできませんか? ichinose ---- BJ様、 ichinose様 こんにちは、まきです。レスが遅れてしまい大変申し訳ございませんでした。 今回の説明が足りなくて申し訳ございませんでした。行いたい内容は、 Sheet2〜数十シート目まで1日のlot_dataのcsvが貼り付けています。Sheet1には、menu ボタンやlot_dataの代表項目の一覧表を表記しています。Sheet1に有る表からグラフに したlot_noを選び、グラフにしたい項目値(ファームが立ち上がり)を選択し、各項目の 最大値を入れます。(自動入力も出来、選択されたlot_noの各項目の最大値を選ぶ) 各シートからグラフに出したい値のみをSheet("temp")にcopyして、ここからSheet(" グラフ")に4軸(最大)の折れ線グラフで書かせます。(将来6軸まで) Sheet("グラフ")には、下記の様なレイアウトで選択されたsheet分書き込みます。 | | Sheet2 | Sheet3 | | ------------------------ | | Sheet4 | Sheet5 | | 多軸グラフは、2軸以降は変数を使い1軸グラフで最大4軸を作っております。故に Y軸に2〜4軸目の目盛、数値、項目名と表記したい(グラフの左側)為に、PlotArea.Heightの上と下 をセルのRowの幅(案は8行)に合わせたいと思います。 BJ様 プロットエリアのみを図形(jpg等)にする事が出来るのでしょうか?もし可能であれば、 絵として貼り付け、Y軸その他をシートに表記すればいいので、出来る様な気がします。 ichinose様 サンプルを上げて頂き有り難うございました。動作させた所、高さも幅もセルに合わせ て記述出来ました。このVBAをベースに私のVBA(シートのボタン)に移しましたが、 ichinose様のサンプル通りの動きをしませんでした。(取りあえずTOPしか行っていませんが) (前と変わらない)修正後のVBA(長いのでグラフ部のみ)は、次の通りです。ちなみに、 ブレークポイントを入れて、数値が入っているかどうかをみましたが、数値は全部入っていました。 'グラフ作成 'グラフを制作する情報の収集 Dim hh As Double Sheets("temp").Activate '作成するグラフの数を数える With ActiveSheet .Range("IV" & 始行).Select Selection.End(xlToLeft).Select グ数 = ActiveCell.Column - 5 完了 = Left(ActiveCell.AddressLocal(, False), 1) 'Columnアドレスをアルファベット値で取得 開始 = "F" '深度のdata場所 .Range("B65536").Select '最終行の検索 Selection.End(xlUp).Select 最終行 = ActiveCell.Row ラベル範囲 = "F" & 始行 & ":" & 完了 & 始行 & "" End With x軸 = "=temp!R" & 始行 + 1 & "C2:R" & 最終行 & "C2" 'グラフシートへエリア選択 Sheets("グラフ").Activate If 回数 Mod 2 <> 0 Then '奇数時 整数 = Application.RoundUp(回数 / 2, 0) + Application.RoundDown(回数 / 2, 0) * 21 + 1 Set グラフ範囲 = Sheets("グラフ").Range("J" & 整数 & ":N" & 整数 + 20) Set プロット範囲 = Sheets("グラフ").Range("J" & 整数 + 5 & ":N" & 整数 + 13) Else '偶数時 整数 = Application.RoundUp(回数 / 2, 0) + (Application.RoundUp(回数 / 2, 0) - 1) * 21 + 1 Set グラフ範囲 = Sheets("グラフ").Range("X" & 整数 & ":AB" & 整数 + 20) Set プロット範囲 = Sheets("グラフ").Range("X" & 整数 + 5 & ":AB" & 整数 + 13) End If Set グラフChart = Sheets("グラフ").ChartObjects.Add( _ グラフ範囲.Left, グラフ範囲.Top, グラフ範囲.Width, グラフ範囲.Height) With グラフChart.Chart hh = .PlotArea.Top - .ChartArea.Top .ChartType = xlLine 'グラフの種類 .SetSourceData Source:=Sheets("temp").Range(ラベル範囲, "F" & 始行 + 1 & _ ":" & 完了 & 最終行 & ""), PlotBy:=xlColumns .SeriesCollection(1).XValues = x軸 .Parent.Top = .ChartArea.Top .PlotArea.Top = 0 'プロットエリアの上の位置 .PlotArea.Width = 240 '1列辺り、約80 .PlotArea.Height = 160 '1行当たり、15(20ピクセル) .PlotArea.Top = hh - .PlotArea.InsideTop + .PlotArea.Top - .ChartArea.Top .PlotArea.Border.Weight = 2 .PlotArea.Border.LineStyle = 0 .PlotArea.Interior.ColorIndex = xlNone .HasDataTable = False .ChartArea.Border.Weight = 2 .ChartArea.Border.LineStyle = 0 .ChartArea.Interior.ColorIndex = xlNone .HasTitle = True .ChartTitle.Characters.Text = "番号:" & 番号 .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "経過時間(sec)" .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "深度(m)" .Axes(xlValue).AxisTitle.HorizontalAlignment = xlCenter .Axes(xlValue).AxisTitle.VerticalAlignment = xlCenter .Axes(xlValue).AxisTitle.Orientation = xlVertical .Axes(xlCategory).HasMajorGridlines = False .Axes(xlCategory).HasMinorGridlines = False .Axes(xlValue).HasMajorGridlines = False .Axes(xlValue).HasMinorGridlines = False .Axes(xlValue).MinimumScaleIsAuto = True .Axes(xlValue).MaximumScaleIsAuto = True .Axes(xlValue).MinorUnit = 1 .Axes(xlValue).MajorUnit = 1 .Axes(xlValue).Crosses = xlMaximum .Axes(xlValue).ReversePlotOrder = True .Axes(xlValue).ScaleType = xlLinear .Axes(xlValue).DisplayUnit = xlNone .Axes(xlCategory).CrossesAt = 1 .Axes(xlCategory).TickLabelSpacing = 60 .Axes(xlCategory).TickMarkSpacing = 60 .Axes(xlCategory).AxisBetweenCategories = True .Axes(xlCategory).ReversePlotOrder = False .Legend.Top = 0 'グラフの凡例の場所(高さ） If グ数 > 3 Then .SeriesCollection(3).Border.ColorIndex = 10 End If End With 始行 = 最終行 + 1 回数 = 回数 + 1 Loop 以上よろしくお願い致します。(まき) ---- 御質問内容とは違いますが。。。 「最終的にはこんなのでも良いのかな?」と思ってみたりします。 ↓コードを載せますが、コードはマクロの記録を切り張りした物なので あまり参考には成りません。 コードを実行して出来たデータと、それを元にして完成したグラフを見て イメージを掴んでもらうと良いと思います。 多くの部分は、今回コードが埋め込むデータ・配置などに 固有の値が直接入れてあります。 '------ Sub データ作成() Dim shn As String If MsgBox("データ作成を開始します。", vbOKCancel) = vbCancel Then Exit Sub End If Sheets.Add Range("A1:C6").Value = _ Evaluate("{""体重"",""身長"",""カロリー"";" & _ "64,160,2203;56.3,153,1778;" & _ "68.1,165,2317;72.3,170,2434 ;" & _ "76.6,175,2553}") Range("A1:C6").Interior.ColorIndex = 35 If MsgBox("A1:C6のデータでグラフを作成します。" & vbLf & vbLf & _ "軸目盛を決定します。 ", vbOKCancel) = vbCancel Then Exit Sub End If Range("F9:H9").Value = Range("A1:C1").Value Range("F2:H2").Value = Array(80, 180, 2700) Range("F3:G8").Formula = "=F2-5" Range("H3:H8").Formula = "=H2-200" Range("F3:H8").Value = Range("F3:H8").Value Range("I2:I8").Formula = _ "=TEXT(F2,""?0"")&"" ""&TEXT(G2,""??0"")&"" ""&TEXT(H2,""???0"")" Range("I9").Value = "↑値ラベルの変わりに表示させたい様に設定" Range("I10").Value = " 今は数式が入っています。" Range("F2:H8").Interior.ColorIndex = 37 Range("I2:I8").Interior.ColorIndex = 34 If MsgBox("I2:I8が軸になるグラフを作成します。" & vbLf & vbLf & _ "軸用データを作成します。", vbOKCancel) = vbCancel Then Exit Sub End If Range("E1:F1").Value = Array("X", "Y") Range("E2:E8").Value = 0.5 Range("E10").Value = "↑Xの値 0.5" Range("E2:E8").Interior.ColorIndex = 39 If MsgBox("軸ラベル用にE2:F8の散布図をグラフに追加します。" & vbLf & vbLf & _ "A2:C6のデータを一つの軸で納まるように変換します。" & vbLf & _ "グラフ用データを作成します。", vbOKCancel) = vbCancel Then Exit Sub End If Dim rng As Range Range("A8:C8").Value = Range("A1:C1").Value Range("A9:A13").Formula = "=A2" Range("B9:B13").Formula = "=B2-100" Range("C9:C13").Formula = "=(C2+500)/40" Range("A14").Value = "↑A8:C13で折れ線グラフを作成" Range("A8:C13").Interior.ColorIndex = 38 With Range("A8:C13,E2:F8") .Borders(xlEdgeLeft).Weight = xlMedium .Borders(xlEdgeTop).Weight = xlMedium .Borders(xlEdgeBottom).Weight = xlMedium .Borders(xlEdgeRight).Weight = xlMedium End With End Sub Sub グラフ作成() Dim shn As String, xlbl As Range, i As Long shn = ActiveSheet.Name If MsgBox("グラフを作成します。" & vbLf & vbLf & _ "A8:C13のデータで折れ線グラフを作成" & vbLf & _ "E2:F8のデータで作った散布図を追加" & vbLf & _ "後は、それっぽく見えるように整えます。", vbOKCancel) = vbCancel Then Exit Sub End If shn = ActiveSheet.Name With Charts.Add .ChartType = xlLineMarkers .SetSourceData Source:=Sheets(shn).Range("A8:C13"), PlotBy:=xlColumns With .Legend .AutoScaleFont = False: .Font.Name = "MS ゴシック": .Font.Size = 10 End With With .Axes(xlCategory).TickLabels .AutoScaleFont = False: .Font.Name = "MS ゴシック": .Font.Size = 10 End With .Location Where:=xlLocationAsObject, Name:=shn End With ' ★散布図を追加して、整える With ActiveChart With .SeriesCollection.NewSeries .ChartType = xlXYScatter .XValues = "=" & shn & "!R2C5:R8C5" .Values = "=" & shn & "!R2C6:R8C6" .MarkerBackgroundColorIndex = xlNone .MarkerStyle = xlNone .ApplyDataLabels ShowCategoryName:=True With .DataLabels .AutoScaleFont = False: .Font.Name = "MS ゴシック": .Font.Size = 10 .Position = xlLabelPositionLeft End With For Each xlbl In Range("I2:I8") i = i + 1 .Points(i).DataLabel.Characters.Text = xlbl Next End With With .Axes(xlValue) .TickLabelPosition = xlNone .MinimumScale = 50: .MaximumScale = 80: .MajorUnit = 5 .HasTitle = True With .AxisTitle .Characters.Text = "体重 身長 Cal" .AutoScaleFont = False: .Font.Name = "MS ゴシック": .Font.Size = 10 .Orientation = xlHorizontal End With End With With .Parent .Width = 500: .Height = 300 End With With .PlotArea .Width = 350: .Height = 250: .Top = 50: .Left = 100 End With With .Axes(xlValue).AxisTitle .Left = 10: .Top = 10 End With End With MsgBox "グラフ作成完了。" & vbLf & vbLf & _ "A8:C13のデータで作った折れ線グラフの数値軸ラベルを無しに" & vbLf & _ "E2:F8のデータで作った散布図のXの値（ラベル）を表示・配置を左に" & vbLf & _ "ラベルの内容はマクロが、E列の値からI列の値に書き換えています。" & vbLf & _ "散布図のマーカーなどは表示無しに。" End Sub '------ ご参考程度に。 (HANA) ---- HANA様 遅い時間にレスを頂き有り難うございました。 早速試した所、何カ所かエラーで止まった為に("With .SeriesCollection.NewSeries”以降)下記の通り 変更しましたが、HANA様の言われる通り(MsgBox)の動きはしませんでした。変更した箇所は次の通りです。 With ActiveChart With .SeriesCollection.NewSeries .ChartType = xlXYScatter .XValues = "=" & shn & "!R2C5:R8C5" '.Values = "=" & shn & "!R2C6:R8C6" '.MarkerBackgroundColorIndex = xlNone '.MarkerStyle = xlNone '.ApplyDataLabels ShowCategoryName:=True 'With .DataLabels ' .ShowCategoryName = True ' .ShowValue = False ' .AutoScaleFont = False: .Font.Name = "MS ゴシック": .Font.Size = 10 ' .Position = xlLabelPositionLeft 'End With End With With .Axes(xlValue) .TickLabelPosition = xlNone .MinimumScale = 50: .MaximumScale = 80: .MajorUnit = 5 .HasTitle = True With .AxisTitle .Characters.Text = "体重 身長 Cal" .AutoScaleFont = False: .Font.Name = "MS ゴシック": .Font.Size = 10 .Orientation = xlHorizontal End With End With With .Parent .Width = 500: .Height = 300 End With With .PlotArea .Width = 350: .Height = 250: .Top = 50: .Left = 100 End With With .Axes(xlValue).AxisTitle .Left = 10: .Top = 10 End With End With ActiveChart.SeriesCollection.NewSeries.Values = "=" & shn & "!R2C6:R8C6" ActiveChart.SeriesCollection.NewSeries.MarkerBackgroundColorIndex = xlNone ActiveChart.SeriesCollection.NewSeries.MarkerStyle = xlNone ActiveChart.SeriesCollection.NewSeries.ApplyDataLabels ShowCategoryName:=True HANA様のVBAやichinose様のVBAを参考に再度検討してみます。。。。（まき） ---- どこでどんなエラーになって止まったのか教えて下さい。 シートにデータを作る所までは動きましたか? その後、折れ線グラフも出来ましたか? (HANA) ---- 済みません。ラベルはマクロで直接変更出来たので 表示形式を変える必要は有りませんでした。 上のコードを直接変更します。 今回は、データ作成マクロとグラフ作成マクロに分けました。 まず、データ作成マクロを実行した後 同じシートで、グラフ作成マクロを実行してみて下さい。 ・・・とはいえ、エラーになる原因が分かって対処した訳では無いですが。。。 どこでどの様なエラーに成って止まるのか教えて下さい。 (HANA) ---- HANA 様 まきです。連絡が遅れてすいませんでした。 ごめんなさい、私はシートのボタンにHANA様のVBAを張って実行させてしまいました。 新規のbookで標準モジュールに入れた所、想像してた物とは違いましたが(プロットエリアとセルの 高さを合わせる)、結果的に行いたいのはY軸の目盛ラベルを3,4軸と合わせるだけなので、HANA様の VBAでも全然OKです。ichinose様のもそうでしたが、やはり標準モジュールに入れて(現在はシートの VBA→Private Sub グラフ_Click()で行っている)行う物でしょうか?それであれば、Sheet1のVBAに >Call mk_graph(データエリア, グラフ範囲, プロット範囲)で 標準モジュールに > Sub mk_graph(ByVal データエリア As Range, ByVal グラフ範囲 As Range, プロット範囲 As Range) と飛ばしてみます。(実は昨日この様にしているのですが。。。但し、上手にいっていませんが) 以上よろしくお願い申し上げます。（まき） ---- えっと。。。仰って居られることがよく分かりません。 上で載せたコードは、散布図用のデータ範囲や 軸ラベル用のセル範囲等 決まった場所を使っているので直接コード内に書いてありますが 実際はそれぞれ違ってくると思います。 あのようにすれば、3軸っぽく見せられる と言うサンプルコードですから 現在出来ているコードに合うように変えて貰う必要が有ると思います。 (HANA)... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201003/20100324114103.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97013 documents and 608132 words.
訪問者：