VBAで別のシートに図形描画

質問

お世話になっております。
現在VBAにおいて以下のものを作っております。

Sheet3で設定を行い、コマンドボタンを押下すると
Sheet2に描画を行う

ところが
Range(Sheets("Sheet2").Cells(HightCnt, WidthCnt), Sheets("Sheet2").Cells(HightCnt, WidthCnt)).Select
のところで
「実行時エラー'1004' Rangeメソッドは失敗しました」
となります。
（どうも同じシートSheet3に描画する分には問題ないようなのですが）

コマンドボタン押下時に別シートにデータ出力等行うことはできないのでしょうか？
もしできるのであれば方法をおしえていただけませんでしょうか？

よろしくお願いします。

回答No.7

Wendy02 · ベストアンサー

Wendy02です。
補足：
>まあ、ちょっとびっくりです。^^;配列変数に入れて、それを後で吐き出すわけですね。

途中を省いてしまいましたので、意味が分かりませんよね。#5の補足とお礼をみて、それだけ出来きているなら、こんなところで躓くなんて・・・、というところなんです。^^;

私は、こういう処理の場合は、そのまま、Range型の変数に入れてしまうかもしれない、と思いましたが。

With Sheets("Sheet2")
　With .Range(.Cells(12, 3), .Cells(120, 120))
　　.Borders.LineStyle =xlNone '罫線を全部消す
　End With

・
・
End With

罫線をまとめて消す場合は、このようにします。
それから、オートシェイプの線ではありませんでしたね。その場合は、描画不活性化という現象は起きませんね。

回答No.6

Wendy02

こんばんは。Wendy02です。

まあ、ちょっとびっくりです。^^;配列変数に入れて、それを後で吐き出すわけですね。

言われてみれば、それは、簡単なところなのですね。

以下のように修正してみてください。Rangeオブジェクトは、標準モジュールからですと、Application のメンバーになるのですが、シートモジュールだと、否応なく、そのシートの配下にされてしまうので、シートとの整合性がないと、エラーが出てしまいます。そこで、「With」ステートメントで、くくってあげないといけません。

前回書いたように、これは、なかなか、気づきにくい一つです。仮に、標準モジュールでも、同じように、「With」ステートメントで書くのが正しいです。それぞれに「.(ドット)」が入っていますから、貼り付けしないのでしたら、気をつけて書いてください。Range の前、Cellsの前に入っています。

それから、これは、Select を使っていますから、画面が激しく点滅しますから、描画の手前からで良いですから、

　Application.ScreenUpdating = False

' 中身

　Application.ScreenUpdating = True

で、コードを包んでください。これは、オートシェイプの時は、別の意味もあります。画面が不活性になってしまっても、ScreenUpDating で活性化します。本来は、Select を使わなくても出来ますが、今は、これだけでも十分だと思います。これで、コードは通るはずです。

'------------------------------------------
描画の部分から

　'==========================================================
　'描画
　'==========================================================
　With Sheets("Sheet2")　'←ココ
　　.Select　'←ココ
　　'-------------------------------------------------
　　'まずは消す
　　'-------------------------------------------------
　　.Range(.Cells(12, 3), .Cells(120, 120)).Select　'←ココ

　　～　中略　～
For HightCnt = 1 To 100
　　　For WidthCnt = 1 To 100
　　　　'セルを選択する
　　　　.Range(.Cells(HightCnt + 12, WidthCnt + 2), _
　　　　　.Cells(HightCnt + 12, WidthCnt + 2)).Select '←ココ

　　　　　～　中略　～

　　 Next WidthCnt
　　Next HightCnt
　End With　　'←ココ
End Sub

回答No.5

Wendy02

こんにちは。Wendy02です。

>ちなみにNo1の回答者さんがおっしゃるように関数をモジュールの方に移すとうまく動きました。

それは結果論だと思います。コマンド・ボタンだけで使用するコードをあえて、標準モジュールに移さなくてはならないようなことはありません。きちんと基本に忠実にコードが書けていれば、ローカル・モジュールで通ります。エラーの原因は、簡単にいうと、ローカル・オブジェクトのSheet3に対して、Rangeオブジェクトの論理的な矛盾があるからです。だいたい、ローカルと標準モジュールの違いがはっきりとしない、1年間ぐらいは、同じようなミスを時々起こしてしまいます。

しかし、ローカル・オブジェクトのSheet3 から、他のシートの　Cells プロパティも、Range プロパティ(オブジェクトではない方)も、それ自体を直接指名しても、Select では飛びません。(他に方法はあります)　.Selectでは、ローカルモジュールの範囲は、オブジェクトを一旦替えてあげないといけないので、シートの変更(Worksheets("Sheet2").Select 等)が必要になります。

元々、Sheet3の静的なデータに対して何かを加えるわけではないのなら、Sheet2 にコマンドボタンがあったほうが良いかもしれません。別に、書式設定で指定すれば、印刷に映るわけでもないし、私なら、そのように作ります。

全体的なもの、特に、HightCnt,WidthCnt は、実際は、どのような流れで、何を拾っているのか分かれば、また、よろしければ、こちらでも考えてみます。

それと、.Shapes.AddShape　は、あまり繰り返さないほうがよいです。バージョンによって、線画が不活性化することがあります。

お礼

ありがとうございます。
単純かもしれませんが、ソースコードをSheets3に戻し、Sheets("Sheet2").SelectとしてみましたがWorksheets("Sheet2").Select でNGとなってしまいました。

ちなみにソースコードを載せてみます。
（これでは分からないかもしれませんが）

Sheets3(excel Object)
'**************************************************************
'ウエハー描写ボタン押下時
'**************************************************************
Private Sub WeferDrawBtn_Click()
Call WeferDrawBtnFunc
End Sub

標準モジュール
'**************************************************************
'ウエハー描写ボタン押下時
'**************************************************************
Public Sub WeferDrawBtnFunc()
Dim WidthSize As Integer '横のサイズ
Dim HightSize As Integer '縦のサイズ
Dim WidthCnt As Integer '横のカウンタ
Dim HightCnt As Integer '縦のカウンタ
Dim CellName As String 'セルの名前
Dim CellData(110, 110) As Integer 'セルのデータ

'==========================================================
'縦と横のサイズを取得
'==========================================================
WidthSize = Sheets("Sheet3").Range("B3") '横のサイズ
HightSize = Sheets("Sheet3").Range("B2") '縦のサイズ

'==========================================================
'各セルの設定を取得
'==========================================================
For HightCnt = 1 To 100
For WidthCnt = 1 To 100
If HightCnt <= HightSize And WidthCnt <= WidthSize Then
'セルの情報を取得
CellData(HightCnt, WidthCnt) = Val(Sheets("Sheet3").Cells(5 + HightCnt, 1 + WidthCnt))
Else
CellData(HightCnt, WidthCnt) = 0
End If
Next WidthCnt
Next HightCnt

補足

こんなことはして良いか分かりませんが、すいません続きです。

'==========================================================
'描画
'==========================================================
Sheets("Sheet2").Select
'-------------------------------------------------
'まずは消す
'-------------------------------------------------
Range(Sheets("Sheet2").Cells(12, 3), Sheets("Sheet2").Cells(120, 120)).Select
'右下がりの線は描かない
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
'右上がりの線は描かない
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
'左横の線は描かない
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
'上側の線は描かない
Selection.Borders(xlEdgeTop).LineStyle = xlNone
'下側の線は描かない
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
'右側の線は描かない
Selection.Borders(xlEdgeRight).LineStyle = xlNone
'選択範囲の左右端以外の境界線は描かない
Selection.Borders(xlInsideVertical).LineStyle = xlNone
'選択範囲の上下端以外の境界線は描かない
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'-------------------------------------------------
'次に書いていく
'-------------------------------------------------
For HightCnt = 1 To 100
For WidthCnt = 1 To 100
'セルを選択する
Range(Sheets("Sheet2").Cells(HightCnt + 12, WidthCnt + 2), Sheets("Sheet2").Cells(HightCnt + 12, WidthCnt + 2)).Select
'使用する部分は描く
If HightCnt <= HightSize And WidthCnt <= WidthSize _
And CellData(HightCnt, WidthCnt) = 1 Then
'右下がりの線は描かない
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
'右上がりの線は描かない
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
'左横の線を描く
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'上側の線を描く
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'下側の線を書く
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'右側の線を書く
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
Next WidthCnt
Next HightCnt

回答No.4

myCat

endy02さん、こんばんは。
ちょっと気になるところがありましたので便乗質問させて下さい。

>>Sheet3で設定を行い、コマンドボタンを押下すると
>>Sheet2に描画を行う
>>ところが
>>Range(Sheets("Sheet2").Cells(HightCnt, WidthCnt), Sheets("Sheet2").Cells(HightCnt, WidthCnt)).Select
>>のところで「実行時エラー'1004' Rangeメソッドは失敗しました」

描画のところは何も書いてないので置いておいて、上記エラーについて

＞エラー自体は、Range オブジェクトをSheet オブジェクトでカバーしてあげればよいだけなのですが

と回答されてますが、
この●Sheetオブジェクトでカバー●とはどういうことなのでしょうか
例えば、次のようにRangeオブジェクトの前にSheetオブジェクトを付加すれば
Sheet2をSelectしなくてもエラーを回避できるということでしょうか。

Sheet3のCommandButton Clickイベント
-----------------------------------------------------
Private Sub CommandButton1_Click()
　　With Sheets("Sheet2")
　　.Range(.Cells(1, 1), .Cells(2, 3)).Select
　　End With
End Sub
-----------------------------------------------------

後学の為に是非ご教授ください。
意味を取り違えていましたら「VBA齧り始め」の戯言とご容赦ください。
何れにしろ、Wendy02さんのVBAの回答はとても勉強になります。
いつも感謝しながら眺めております。

ここからは質問者へ。
因みに当方の回答は標準モジュールでしか動かないコードです。
Sheet3に置く場合はシート名を付け加えないといけないのですが
それは試してみてエラーが出たら再度質問するでしょうから、
その時点でそこは回答した方がより理解が深まるかなと思い書きませんでした。

お礼

ご返答ありがとうございます。

Selectオブジェクトでセルを選択してもうまくできませんでしたが
withでうまくできるかは試してみます。

ありがとうございました。

回答No.3

Wendy02

こんばんは。

Sheet3 のコマンドボタンですから、Sheet3 に書いてかまわないですが、コードの全部をみないと分からないものがありますね。書き方にもよりますが、特別、Select も必要だも思いません。

エラー自体は、Range オブジェクトをSheet オブジェクトでカバーしてあげればよいだけなのですが、コードを見る限りは、Rangeオブジェクトで範囲を設定しているようにないのです。

コードの変数からの単なる想像ですから、意味が違うかもしれませんが、セルに対して範囲を設定するなら、以下のような感じにならないでしょうか？また、どちらかというと、このようなサイレントモードは、最後に、.Select を入れ目視するか、メッセージか、Beep を入れて音で確認しないと、別のシートに、いくつ同じものを作っているきか気が付きません。

'------------------------------------------------------
Private Sub CommandButton1_Click()
　Dim HightCnt As Long '高さ
　Dim WidthCnt As Integer '幅
　Dim sLocation As String '位置
　Dim r As Range
'---------------------------------
'本来は、シートからの呼び出し？
　sLocation = "A1"
　HightCnt = 10
　WidthCnt = 3
'---------------------------------
　With Worksheets("Sheet2")
　　Set r = .Range(sLocation).Resize(HightCnt, WidthCnt)
　　.Shapes.AddShape(msoShapeRectangle, r.Left, r.Top, r.Width, r.Height).Select
　　Set r = Nothing
　End With
　Beep
End Sub

'------------------------------------------------------

お礼

ご返答ありがとうございます。

私がやりたかったことは
Sheets3のB6～BS60に1が立っているものは
Sheets2の該当する部分のセルに罫線を引くというものです。
(シリコンウエハーの形状・測定結果を描くマクロを組んでいるため)

本当はRange("B6").Selectといったようにやりたかったのですが
ループでまわしながら描くのにどうして良いか分からず
Range(Sheets("Sheet2").Cells(HightCnt, WidthCnt), Sheets("Sheet2").Cells(HightCnt, WidthCnt)).Selectとしたのです。

Range変数なんてあるのですね。
試してみます。

ちなみにNo1の回答者さんがおっしゃるように関数をモジュールの方に移すとうまく動きました。

ありがとうございました。

回答No.2

myCat

こんにちは。

原因は、Sheet2がアクティブでないのに、Sheet2のセルをSelectしているからです。
次のように先ず、Sheet2をアクティブにしてから、セルのSelectです。

Sheets("Sheet2").Select
Range(Cells(HightCnt, WidthCnt), Cells(HightCnt, WidthCnt)).Select

Sheet2をアクティブにしてあるのにエラーが出る場合は、変数HightCnt,WidthCntの値が不適切な値です。

以上です。

お礼

ありがとうございます！
モジュールの方にコードを移動してみたら実行できました。
ありがとうございました！

回答No.1

ASIMOV

コードを Sheet3 に記述していませんか？
他のシートに関わるコードは標準モジュールに記述しないと動きません

お礼

早速のご回答ありがとうございます。
Sheet3にコードを書いていました。
コードを標準モジュールに書いてみます。
ありがとうございました！