トップ «前の日記(2009-04-13) 最新 次の日記(2009-04-15)» 編集

日々の破片

Subscribe with livedoor Reader
著作一覧

2009-04-14

_ Excelいじり

なんか、えらく面倒なExcelのお絵かきが必要になって、それは四角の中にテキストを入れて、場合によってはその四角に別の四角がくっついて(しかも、それにもテキストがある)いて、しかも全部で四角が200個くらいある。

それだけあると、人間がうまいこと並べてやらなければだめだが、かといってすべて手作業するのはいやなこった。というわけで、あまり気はすすまないが、マクロを使って、別のシートの表に埋まっているテキストを取り出して四角を配置しておくものを作った。

が、ときどきうまく動き、ときどきうまく動かない。

'思い出して書いているので嘘もあるはず。
Set src = WorkSheets(4)   ' Setを忘れやすい
Set dst = WorkSheets(5)
x = 100
y = 200
For r = 10 To 300
  If src.Range("F" & r).Value = "" Then
    Exit For  ' カラムFが空なら終了
  End If
  If src.Range("G" & r).Value <> "" Then
    Set attr = dst.Shapes.AddShape(msoShapeRectangle, x, y - 24, 240, 12)
    With attr.TextFrame
      .Characters.Text = src.Range("G" & r).Value
      .Characters.Font.Size = 11
    End With
  Else
    Set attr = Nothing
  End If
  Set rc = dst.Shapes.AddShape(msoShapeRectangle, x, y, 240, 40)
  x = x + 260
  y = y + 80
  With rc.TextFrame
    .Characters.Text = src.Range("F" & r).Value
    .Characters.Font.Size = 12
  End With
  If Not attr Is Nothing Then
    attr.Select True   ' 以前の選択をちゃらにする
    rc.Select False    ' 現在の選択に追加
    Selection.ShapeRange.Group ' 2つ四角を作った場合はグループ化
  End If
Next

良くわかったが、MSDNのOffice2003のドキュメントがかすなのは、コレクション、オブジェクト、メソッド、プロパティという項目立てになっていて、それはまあそれで良いとしても、オブジェクトやコレクションからメソッドやプロパティがリンクされていないことだ。そのため、どのオブジェクトで何が使えるかさっぱりわからない。

一部についてはインテリセンスが効くから良いとしても、Selectionなんかはインテリセンスが効かないので全然だ。

で、うまく動くときは、上でWorkSheet(5)としているシートがフォアグラウンドとして表示されている時だということがわかり、しかし、なぜそうでなければうまく動かないかわからなかった。

で、これを書いていてわかったが、Selectionは移出されたオブジェクトではなく、デフォルトオブジェクトであるApplicationのプロパティで、アクティブなウィンドウの選択を返すから、うまく動いたり(WorkSheet(5)がフォアグラウンドシート)、動かなかったり(WorkSheet(5)以外のシートがフォアグラウンドシート)するからなのか。考えてみれば、それはそうだな、と納得できるが、とても不思議だった。

というか、もう少し手を入れれば、ほとんど人手の介在は不要にできそうだ。

_ OOO

あらためて上のリストを見ると気に食わない。

こうだな。

'思い出して書いているので嘘もあるはず。
Set src = WorkSheets(4)   ' Setを忘れやすい
Set dst = WorkSheets(5)
x = 100
y = 200
For r = 10 To 300
  If src.Range("F" & r).Value = "" Then
    Exit For  ' カラムFが空なら終了
  End If
  Set rc = CreateRect(dst, x, y, 240, 40, src.Range("F" & r).Value, 12) ' see #c01
  If src.Range("G" & r).Value <> "" Then
    Set attr = CreateRect(dst, x, y - 24, 240, 12, src.Range("G" & r).Value, 11)
    attr.Select True   ' 以前の選択をちゃらにする
    rc.Select False    ' 現在の選択に追加
    Selection.ShapeRange.Group ' 2つ四角を作った場合はグループ化
  End If
  x = x + 260
  y = y + 80
Next
...
Private Function CreateRect(ByVal dst As WorkSheet, ByVal x As Single, ByVal y As Single, ByVal w As Integer, ByVal h As Integer, ByRef txt As String, ByVal sz As Integer)
    Set s = dst.Shapes.AddShape(msoShapeRectangle, x, y, w, h)
    With s.TextFrame
      .Characters.Text = txt
      .Characters.Font.Size = sz
    End With
    Set CreateRect = s
End Function

で、ここまでは良いとして、次の修正をするかどうかが思案どころだ。

おれは、平気だし、むしろ、次のようにしたほうが良いと思うが、純粋主義者であれば、CreateRectがそれ以外のロールを果たすことに嫌な匂いを嗅ぐと想像できるからだ。

Set src = WorkSheets(4)   ' Setを忘れやすい
Set dst = WorkSheets(5)
x = 100
y = 200
For r = 10 To 300
  Set rc = CreateRect(dst, x, y, 240, 40, src.Range("F" & r).Value, 12)
  If rc Is Nothing Then
    Exit For
  End If
  Set attr = CreateRect(dst, x, y - 24, 240, 12, src.Range("G" & r).Value, 11)
  If Not attr Is Nothing Then
    attr.Select True   ' 以前の選択をちゃらにする
    rc.Select False    ' 現在の選択に追加
    Selection.ShapeRange.Group ' 2つ四角を作った場合はグループ化
  End If
  x = x + 260
  y = y + 80
Next
...
Private Function CreateRect(ByVal dst As WorkSheet, ByVal x As Single, ByVal y As Single, ByVal w As Integer, ByVal h As Integer, ByRef txt As String, ByVal sz As Integer)
    If txt = "" Then ' fixed on 4/22 (see #c04)
      Set CreateRect = Nothing ' see #c01
      Exit Function
    End If
    Dim s As WorkSheet ' fixed at 4/21
    Set s = dst.Shapes.AddShape(msoShapeRectangle, x, y, w, h)
    With s.TextFrame.Characters ' fixed see #c04
      .Text = txt
      .Font.Size = sz
    End With
    Set CreateRect = s
End Function
本日のツッコミ(全5件) [ツッコミを入れる]
_ FILE (2009-04-17 21:27)

本題とは無関係の野暮なツッコミですが、<br>CreateRect内の「If txt == "" Then」とか、そのまま「Exit Function」だとEmptyが返る事とかが気になりました。<br>あと、dstも引数で受け取る方が良さそう。

_ arton (2009-04-18 02:03)

どうもありがとうございます。確かにそうですね。>Empty<br>修正します。<br>引数は、ケースバイケースで、これはそういうケースの例ということで。(たとえば、5とかしているけど、実際は定数だとか)

_ arton (2009-04-18 02:06)

ああ、dstってWorkSeets(5)のほうじゃなくてですね。<br>これも修正します。どうもありがとうございます。

_ FILE (2009-04-22 00:32)

VBAの等価演算子は「==」ではなく「=」だと言う事が、ツッコミのメインでした。判り難くてすみません。<br>#「次のようにしたほうが良いと思うが」なので、実際に試されたわけではない様ですし。<br>#この記事を参照した人がそのままコピーすれば、構文チェックで赤くなって気付くと思いますし。<br><br>以下、私なりに整理したものを書いてみます(変数名はそのまま使用させていただきました)。ご参考まで。<br>Private Function CreateRect(dst As Worksheet, x As Single, y As Single, w As Single, h As Single, txt As String, sz As Integer) As Shape<br> Set CreateRect = Nothing<br> If txt <> "" Then<br> Set CreateRect = dst.Shapes.AddShape(msoShapeRectangle, x, y, w, h)<br> With CreateRect.TextFrame.Characters<br> .Text = txt<br> .Font.Size = sz<br> End With<br> End If<br>End Function<br><br>私がVBAのコード作成時に注意する点もいくつか書いておきます。(釈迦に説法かもしれませんが…)<br>▼設定<br> ・ツール→オプション→編集タブ<br>  「自動構文チェック」をOFF / 「変数の宣言を強制する」をON(←Option Explicit必須)<br>▼確認<br> ・デバッグ→VBAProject のコンパイル (警告が出ない事を確認)<br>▼検討<br> ・下記でも使用されている Application.ScreenUpdating も有用ですね。<br>  http://www.artonx.org/collabo/backyard/?RubyScriptTemplate

_ arton (2009-04-22 02:51)

どうもありがとうございます。<br>確かに、==はまずいですね。直します。<br>それに、FILEさんの例のCharactersまでWithにするほうがきれいだし、効率的ですね。あと、「自動構文チェック」をOFFというのは試したことがないので、今度、やってみます。<br>逆に、ネストを深くするより、先頭で条件に合わないのは返すのが良いと思います。<br>つまり、関数の構成は<br>・初期化<br>・条件に合わないものを返したり弾いたり飛ばしたり<br>・本当の処理<br>・後処理<br>という感じにして、条件に合わないものを最後まで引っ張って、肝心な処理がネストの奥に行ったり、別関数になるのを避けるようにする、「いきなりストリップ書法」が好みです。


2003|06|07|08|09|10|11|12|
2004|01|02|03|04|05|06|07|08|09|10|11|12|
2005|01|02|03|04|05|06|07|08|09|10|11|12|
2006|01|02|03|04|05|06|07|08|09|10|11|12|
2007|01|02|03|04|05|06|07|08|09|10|11|12|
2008|01|02|03|04|05|06|07|08|09|10|11|12|
2009|01|02|03|04|05|06|07|08|09|10|11|12|
2010|01|02|03|04|05|06|07|08|09|10|11|12|
2011|01|02|03|04|05|06|07|08|09|10|11|12|
2012|01|02|03|04|05|06|07|08|09|10|11|12|
2013|01|02|03|04|05|06|07|08|09|10|11|12|
2014|01|02|03|04|05|06|07|08|09|10|11|12|
2015|01|02|03|04|05|06|07|08|09|10|11|12|
2016|01|02|03|04|05|06|07|08|09|10|11|12|
2017|01|02|03|04|05|06|07|08|09|10|11|12|
2018|01|02|03|04|05|06|07|08|09|10|11|12|
2019|01|02|03|04|05|06|07|08|09|10|

ジェズイットを見習え