Excel VBA質問箱 IV

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

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


2217 / 13645 ツリー ←次へ | 前へ→

【69336】波線の作成 kanisan 11/6/27(月) 15:23 質問[未読]
【69341】Re:波線の作成 momo 11/6/28(火) 14:24 発言[未読]
【69343】Re:波線の作成 kanisan 11/6/28(火) 15:40 お礼[未読]

【69336】波線の作成
質問  kanisan  - 11/6/27(月) 15:23 -

引用なし
パスワード
   初めて質問させていただきます。
ぜひ皆さんのお知恵をお借りしたく、よろしくお願いいたします。(Mougにも同じ質問をしていますが、どなたからも回答がいただけていないため、こちらにも投稿させていただきました。)

図形の曲線を使って、波線を描画しています。下記マクロにてExcel2003、2010では問題なく描画できているのですが、2007では、図形が大きくなってしまい、波線になりません。(たとえば、Xtopが350だったとしても左上が0,0のところに行ってしまいます。
よろしくお願いいたします。
 
一旦、曲線で始点と終点のみの線を引き、頂点の追加で波線としています。頂点を追加すると図形が大きくなってしまいます。
下記はそのプログラム全てです。
2003、2010では問題なく動きます。(2003と2010では、頂点追加時のインデックスを変更しています。これは、2010でエラーとなるのを回避するためです。)
  
  
Sub Namisen(Xtop, Ytop, Xbotm, Ybotm, myColor)
 
  W = Xbotm - Xtop '幅
  H = Ybotm - Ytop '高さ
  Pol = H / Abs(H) '極性(戻り線の場合にマイナスとなる。)
  P = 4 '波線のピッチ
  Version = Application.Version


  With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, Xtop, Ytop)
    .AddNodes msoSegmentCurve, msoEditingAuto, Xbotm, Ybotm
    .ConvertToShape.Select '書き始めと終りを描画
  End With
  Selection.ShapeRange.Line.ForeColor.SchemeColor = myColor
  
   
  For i = 1 * Pol To H / P Step 1 * Pol
    Pi = P * i
    Px = P * 0.6
  
    If Version < 12 Then
      C = 3 * i * Pol - 2 ' C=1,4,7,10,13,16,19・・・ ・
      '波を追加  オートシェイプ→線→曲線(描画)右クリック 頂点の編集→頂点の追加
    Else
      C = Abs(i)
    End If
    If i Mod 2 = 0 Then
      Selection.ShapeRange.Nodes.Insert C, msoSegmentCurve, msoEditingAuto, _
                Xtop + (i * W * P / H) - Px, Ytop + Pi
    Else
      Selection.ShapeRange.Nodes.Insert C, msoSegmentCurve, msoEditingAuto, _
                Xtop + (i * W * P / H) + Px, Ytop + Pi
    End If
  Next i
    
End Sub

【69341】Re:波線の作成
発言  momo  - 11/6/28(火) 14:24 -

引用なし
パスワード
   ▼kanisan さん:

>(Mougにも同じ質問をしていますが、どなたからも回答がいただけていないため、> こちらにも投稿させていただきました。)

こちらはマルチポスト容認ですが、Mougは許可されていないので
こちらで質問されるなら、向こうは解決済みにされたほうがよろしいかと。

で、2007では以下のようにする事で波線が描けました。
最初にConvertしないでAddNodesで追加してから最後にConvertです。

Sub Namisen(Xtop, Ytop, Xbotm, Ybotm, myColor)
Dim W As Double, H As Double, Px As Double
Dim Pol As Integer, P As Integer
Dim i As Long
W = Xbotm - Xtop '幅
H = Ybotm - Ytop '高さ
Pol = H / Abs(H) '極性(戻り線の場合にマイナスとなる。)
P = 4 '波線のピッチ
Px = P * 0.6
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, Xtop, Ytop)
 For i = Pol To H / P Step Pol
  If i Mod 2 = 0 Then
   .AddNodes msoSegmentCurve, msoEditingAuto, Xtop + (i * W * P / H) - Px, Ytop + P * i
  Else
   .AddNodes msoSegmentCurve, msoEditingAuto, Xtop + (i * W * P / H) + Px, Ytop + P * i
  End If
 Next i
 .AddNodes msoSegmentCurve, msoEditingAuto, Xbotm, Ybotm
 .ConvertToShape.Line.ForeColor.SchemeColor = myColor
End With
End Sub

【69343】Re:波線の作成
お礼  kanisan  - 11/6/28(火) 15:40 -

引用なし
パスワード
   ▼momo さん:

どうもありがとうございました。
mougのほうはすぐに解決済みにさせていただきます。

私もいろいろと試行錯誤をして、ほとんどmomoさんと同じ結論に至りました。
このマクロは、2003で作って、2010でうまく書けなかったため、Version判定を入れていました。
momoさんにご教授いただいた方法ですとこのVersion判定もいらなくなり、マクロがすっきりします。

2007は家のパソコンにしか入っていないため、今日家に帰ってから確認します。
本当にありがとうございました。

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