Excel2007 文字をマルで囲むマクロについて

質問

Excelで
１．あるセルを選択あるいは複数のセルを選択。
２．ボタンをクリックすると、実線のマルで文字を囲む。
　　（線の太さはマクロ内で０．７５を指定）
３．もう一回ボタンをクリックすると点線のマルで文字を囲む。
４．もう一回クリックすると文字はマルで囲まれない。
５．以降、ボタンをクリックすると２．～４．がくり返される。

１．はマウスでセルをクリックする操作をしますが、２．～５．
はマクロを設定したボタンをクリックする操作です。

選択するセルは、離れたセルを複数選択していてもうまく文字を
囲むマクロです。

このボタンに設定するマクロを教えていただけないでしょうか。
（使い方としては、表の上部のセルにボタンをレイアウトし、
　ボタンにマクロを設定し、表の中のセルをクリックしたあと
　マクロを設定したボタンをクリックすると、選択したセルが
　マルで囲まれる。そんな操作です。）

選択するセルに入力されている文字は、
「全角１文字」「全角２文字」「半角１文字」「半角２文字」の
ケースがあります。
できれば、マクロの中でこの４つのケースでもうまくマルあるいは
楕円で文字を囲む処理を一つのマクロでできると助かります。

Excel97でもこのマクロを使います。

難しい質問で申し訳ありません。宜しくお願い致します。

回答No.1

hige_082 · ベストアンサー

＞選択するセルは、離れたセルを複数選択していてもうまく文字を囲むマクロです。
どうせ選択するなら、ダブルクリックでやってもいいかなと
後、丸が増えると遅くなりそうなのと
ループ処理が増えるが面倒なので
ダブルクリック仕様です
どうしても、ボタンがよければアレンジしてくださいね
＞Excel97でもこのマクロを使います。
Excel97は持っていないので未検証です

'対象シートモジュールへ
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Shp As Shape
Cancel = True
If ActiveSheet.Shapes.Count <> 0 Then
For Each Shp In ActiveSheet.Shapes
If Target.Address = Shp.TopLeftCell.Address Then
Select Case Shp.Line.DashStyle
Case 1: Shp.Line.DashStyle = 4: Exit Sub
Case 4: Shp.Delete: Exit Sub
End Select
End If
Next
End If
With ActiveSheet.Shapes.AddShape(msoShapeOval, Target.Left, Target.Top, Target.Width, Target.Height)
.Fill.Visible = msoFalse
.Line.Weight = 0.75
End With
End Sub

参考まで

お礼

hige_082さん、早速の回答ありがとうございます。
昨日から、この回答を見て、何とか自分で解決しようとマクロを貼り付けたりしやって見たのですが、ご回答いただきましたマクロの設定と使い方が分かりませんでした。

式の設定はよく分かるのですが、マクロはボタンに下記形式のマクロを設定したことしかありません。
Sub ○○○()
・・・・・・
End Sub

'対象シートモジュールへ
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,
・・・・・・
End Sub
マクロをどのように貼り付けるのかと、セルを選択してマクロを実行する操作手順が分かりません。
私の持っている古いマクロの書籍を見たのですが、記載がなく分かりませんでした。誠に恐縮な次第ですが、
１．このマクロを設定する手順。
２．セルを選択してからダブルクリック操作しマクロを実行する手順。
をご教授いただけないでしょうか。宜しくお願い致します。

回答No.2

hige_082

＞１．このマクロを設定する手順。
設定したいシートタブを右クリック
コードの表示を選択
シートモジュールが表示される
カーソル位置へコピペ
シートモジュールを閉じる

＞２．セルを選択してからダブルクリック操作しマクロを実行する手順。
マクロを設定したシートを表示
セルをダブルクリックするだけ(ダブルクリックでマクロが起動します）
セルをダブルクリックするたびに
実線→点線→消えるの繰り返し

このマクロは文字を処理対象にしてはいません
セルの上下左右の線に接する丸を表示するだけです
したがってセルが大きければ大きい丸
セルを小さくすれば小さい丸になります

文字を対象にすると、取得しなければいけない情報が多く
マクロが複雑になるので

結合セルも対象にしていたのですが
結合セルではうまく行かない
不具合があったのでマクロを修正してください
6行目
If Target.Address = Shp.TopLeftCell.Address Then
を
If Not Intersect(Target, Shp.TopLeftCell) Is Nothing Then
へ変更してください

もしかすると、こちらの方がより希望に近いかも
マクロの下から5行目を
With ActiveSheet.Shapes.AddShape(msoShapeOval, Target.Left + Target.Width / 2 - 12.5, Target.Top + Target.Height - 13.5, 25, 13.5)
と、置き換えてください

これで分りますか？