Shapeの扱い
Sato
● → 1001
○ → 1002
■ → 1003
□ → 1004
▲ → 1005 と名前をつけてあります。
オブジェクトはAdobeのIllustratorCSで作成したオブジェクトを
コピー&ペーストした後で、Excelでグループ解除→｢これは
インポートされた図でグループではありません。描画オブジェクトに
変換しますか？」を[はい]で変換し、大きさなどExcel上で調整したものです。
Sheet3に下記のようなリストが約230レコードあります。
A B C D
記号種類 X座標(Left) Y座標(Top) 名前
1001 350.5 24 うさぎ
1003 52 359 くじら
1002 180.25 243.5 きりん
1004 290 48 ライオン
1001 250 128 かめ
・ ・ ・ ・
・ ・ ・ ・
・ ・ ・ ・
Sheet3のリストがアクティブな状態で下記のInsert_Symbolを実行したところ、
WinXpProSP2+Excel2000+SP2では問題なくLoopが最終レコードまで処理され正常終了しますが、
WinXpProSP2+Excel2003+SP2では
数回Loopを繰り返しますが、☆Error発生①のコメントの
コードでエラーとなります。エラーが発生するのは6回目Loopのタイミングのようですが、strTypeの値は"1002"ですので、実在するオブジェクトをコピーしようとしています。
エラーメッセージの内容は、
実行時エラー'2147417848(80010108)':
'Copy'メソッドは失敗しました。'Shape'オブジェクト
となっていて、[終了]、[デバック]、[ヘルプ]となるので
[デバック]でVBEを表示して、F8キーを押すと今度は、
実行時エラー'1004':
アプリケーション定義またはオブジェクト定義エラーです
と表示されます。どうにもならないので、一旦終了してSheet上のどこかのセルをクリックしても名前ボックスや数式バーには選択したセルの内容が表示されますが、セルがActiveな状態にならず(四角いカーソルがセルに移表示されないと表現すればよいでしょうか？)まもなくExcelがクラッシュしてしまいます。
また、何回かリブートを繰り返したりするとError発生②やError発生③のコードでも同様の症状があります。
同じリストをExcel2000で実行すると問題ないので、
リストの値に問題があるとも考えにくいと思います。
また、Excel2000でInsert_Symbolができたので保存して終了後
再度Excel2000でファイルを開き、Delete_Symbolを行ったところ
実行時エラー'2147417848(80010108)'
Nameメソッドは失敗しました'Shape'オブジェクト
となり、デバックや終了をクリックしてまもなくExcelがクラッシュします。
こちらは、逆にExcel2003では正常に動作します。
長ったらしいコードで申し訳ありませんが、何かご存知でしたらよろしくお願いします。
Sub Insert_Symbol()
Dim lngCurRow As Long
Dim lngEndRow As Long
Dim objList As Object
Dim strType As String
Dim dblX As Double
Dim dblY As Double
Dim strNAME As String
Dim intCount As Integer
Set objList = Sheets("Sheet3")
lngCurRow = 2
lngEndRow = Range("A65536").End(xlUp).Row
Sheets("Sheet4").Select
Do Until lngCurRow > lngEndRow
With objList
strType = .Range("A" & lngCurRow)
dblX = .Range("B" & lngCurRow)
dblY = .Range("C" & lngCurRow)
strNAME = .Range("D" & lngCurRow)
End With
'シンボルをコピー＆ペースト
Sheets("Sheet2").Shapes(strType).Copy '☆Error発生①
intCount = ActiveSheet.Shapes.Count
ActiveSheet.Paste '☆Error発生②
Application.CutCopyMode = False
With ActiveSheet.Shapes(intCount + 1)
.Name = strNAME 'シンボル名称
.Left = dblX - .Width / 2 'X座標
.Top = dblY - .Height / 2 '座標
End With
'シンボル名称テキストボックスを追加
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, dblX -
10, dblY - 10, _
10, 10).TextFrame.Characters.Text = strNAME '☆Error発生③
ActiveSheet.Shapes(intCount + 2).Select
Selection.Name = strNAME & "_N"
'テキストボックスの設定は、ユーザ環境の既定値に左右されるみたいなので全て設定する。
With Selection
'Font
.Font.Name = "ＭＳ ゴシック"
.Font.FontStyle = "標準"
.Font.Size = 3
.Font.Strikethrough = False '取り消し線
.Font.Superscript = False '上付き
.Font.Subscript = False '下付き
.Font.OutlineFont = False
.Font.Shadow = False
.Font.Underline = xlUnderlineStyleNone
.Font.ColorIndex = xlAutomatic
'表示文字列配置
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.Orientation = xlHorizontal
.AutoSize = True '一時的に自動サイズにしておく
.AddIndent = False
'線と色
.ShapeRange.Fill.Visible = msoFalse
.ShapeRange.Line.Visible = msoFalse
'プロパティ
.Placement = xlMove 'セルに合わせて移動、サイズ変更なし
.PrintObject = True '印刷する
'余白
ActiveSheet.Shapes(strPoleNo & "_N").TextFrame.AutoMargins = False
.ShapeRange.TextFrame.MarginLeft = 0#
.ShapeRange.TextFrame.MarginRight = 0#
.ShapeRange.TextFrame.MarginTop = 0#
.ShapeRange.TextFrame.MarginBottom = 0#
'保護
.Locked = False
.LockedText = True
'サイズ再調整
.AutoSize = False
.Width = .Width * 1.5
'位置再調整
.Top = dblY - .Height * 1.3
.Left = dblX - .Width / 2
End With
lngCurRow = lngCurRow + 1
Loop
Range("A1").Select
End Sub
Sub Delete_Symbol()
Dim varSymbol As Variant
Dim intCount As Integer
intCount = 1
For Each varSymbol In ActiveSheet.Shapes
Debug.Print intCount
If Left(varSymbol.Name, 3) <> "AAA" Then
vaｒSymbol.Delete
End If
intCount = intCount + 1
Next
End Sub
Miyahn
"Sato" さんは、2007年4月6日 14:18 の
「Shapeの扱い」 で、こう書かれました。
> オブジェクトはAdobeのIllustratorCSで作成したオブジェクトを
> コピー&ペーストした後で、Excelでグループ解除→「これは
> インポートされた図でグループではありません。描画オブジェクトに
> 変換しますか？」を[はい]で変換し、大きさなどExcel上で調整したものです。
MS 製以外のグラフィックアプリケーションからコピーしたオブジェクトを
マクロで操作するのはお奨めしません。
グループ解除しても、妙なレイヤー構造が残っていたりして挙動が不定です。
はっきり言って何が起こるかはわかりません。
オートシェイプを工夫して使いましょう。
--
Miyahn
Microsoft MVP for Microsoft Office - Excel(Jan 2004 - Dec 2007)
Miyahn's Archive: http://homepage2.nifty.com/miyahn/
Sato
> マクロで操作するのはお奨めしません。
> グループ解除しても、妙なレイヤー構造が残っていたりして挙動が不定です。
> はっきり言って何が起こるかはわかりません。
>
> オートシェイプを工夫して使いましょう。
IllustratorからコピペしたオブジェクトがあるSheet2をシートごと削除し、
新しいシートを挿入してシート名をSheet2に変更した上で、
全てオートシェイプで記号を作り直しました。といっても、
①円(楕円をShiftキーを押しながら)
②フローチャートの和接合
③円の左半分だけを塗りつぶした記号
(曲線で左半円を描き閉じた曲線にして黒で塗りつぶしたものと
曲線で右半円を描き閉じた曲線にして白で塗りつぶしたものを
グループ化したもの)
④②の和接合の左右の扇形部分を黒で塗りつぶした記号
(フリーフォームで4角形をつくり、頂点編集で頂点を中心にスムージングする等
行って扇形を作り、黒と白でそれぞれ塗りつぶしてグループ化したもの)
⑤2重円の内側の円の左半分だけ黒で塗りつぶしたもの)
(③で作った円の左半分を塗りつぶした記号と一回り大きい①で作った円を
重ねて(2重円の内側の円の左側が黒で塗りつぶしたもの)グループ化したもの)
の5種類です。
この状態で前回投稿した
Insert_SymbolとDelete_Symbolを行ったところ、
前回同様の結果となってしまいました。
前回同様エラーが発生するコードも同じ箇所でした。
Insert_Symbolを行う際に、
Excel2000では、1秒間に数レコード処理しているようで
画面上でも記号やテキストボックスが配置されるのを目視で
追っていくのは困難ですが、Excel2003では1秒間に1レコード程度
の動きで目視でも追いかけられる状況でストレスを感じるレスポンスです。
Shapeオブジェクトの扱い方の仕様など変更されたのでしょうか？
Miyahn
# 投稿／閲覧には Web ベースでないニュースリーダの利用を推奨します。
# 使わないようにしましょう。
"Sato" さんは、2007年4月17日 10:38 の
「Re: Shapeの扱い」 で、こう書かれました。
> 全てオートシェイプで記号を作り直しました。
> この状態で前回投稿した
> Insert_SymbolとDelete_Symbolを行ったところ、
> 前回同様の結果となってしまいました。
> 前回同様エラーが発生するコードも同じ箇所でした。
> Shapeオブジェクトの扱い方の仕様など変更されたのでしょうか？
# 前回は長大なコードなので全部読んでいませんでした。m(__)m
（オートシェイプの）テキストボックスの再描画処理は Excel2000 で
変更されており、これによる速度低下はバカになりません。
同一のマシンでテストされているのか不明ですが、マシンのグラフィック
ドライバ（の設定）によっては、Excel2000 以降のどのバージョンでも
障害が出る恐れがあります。
自動サイズ調整をオンにしたものを含むテキストボックスを十数個以上
挿入するのは避けましょう。
参考サポート技術情報はこちら。
[XL2003]テキストボックスが多いファイルを開くのに時間がかかる
文書番号: 834137
# 私の勤務先で、CPU が Celeron の低スペックのマシンでは 5秒で開くのに、
# クロックが 5倍の Pentium マシンで開くのに 2分かかった事例があります。
# テキストボックスを使わないように作り直したところ、後者でも計測不能な
# ほど短時間で開くようになりました。