Excel小技集2

（対象）Excel　VBA
（確認）Excel2003


今回はExcel VBAの小技集パート2を並べてみましょう。
内容によっては2007以降は使えないのでご注意ください。


－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

１．対象のブックを他に開いている人がいないか調べる

　　＝　ActiveWorkbook.UserStatus
　　　　・・・UserStatus(n, 1)　：　ユーザー名
　　　　・・・UserStatus(n, 2)　：　ブックを開いた日時
　　　　・・・UserStatus(n, 3)　：　共有（2）か否（1）か
　　　　参照URL
　　　　※というかここの通りなだけなので細かいことはリンク先を見た方がいい


　（使用例）
　　　'===========================================================
　　　' 対象のブックをほかに開いている人がいないかどうかを調べる
　　　'===========================================================
　　　Sub　CheckAnotherUser()
　　　　　Dim　Users　As　Variant
　　　　　Dim　MSG　　As　String
　　　　　Dim　I　　　As　Integer

　　　　　'■変数に対象の結果を格納
　　　　　Users　=　ActiveWorkbook.UserStatus

　　　　　'■変数の最大数が1の場合は自分だけ、それ以上の場合は誰かが開いている
　　　　　'※UBound(配列変数)　＝　配列変数の最大要素数の取得
　　　　　If　UBound(Users)　=　1　Then
　　　　　　　MsgBox　"他に開いているユーザーはいません"
　　　　　Else
　　　　　　　For　I　=　0　To　UBound(Users)　-　1
　　　　　　　　　MSG　=　Users(I,　1)　&　"　:　"　&　Users(I,　2)　&　vbCrLf
　　　　　　　Next
　　　　　　　MsgBox　"あなた以外の誰かがブックを開いています　:　"　& _
　　　　　　　　　　　　vbCrLf　&　MSG
　　　　　End　If
　　　End　Sub


　（解説）
　　　今開いているブックを開いている人が自分以外に誰かいるかを確認。
　　　ブックを指定するならば「ActiveWorkbook」を「Workbooks(ファイル名)」に
　　　してもよい。


－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

２．範囲内の図形の削除
　　参照URL


　（使用例）
　　　'===========================================================
　　　' 範囲内の図形の削除
　　　'===========================================================
　　　Sub　DeleteShape()
　　　　　Dim ShapTop As Double
　　　　　Dim ShapLeft As Double
　　　　　Dim ShapBotom As Double
　　　　　Dim ShapRight As Double
　　　　　

　　　　　'■指定セル範囲の上下左右の位置情報を取得
　　　　　With　WHX.Range("A15:E30")
　　　　　　　ShapTop = .Top
　　　　　　　ShapLeft = .Left
　　　　　　　ShapBotom = .Top + .Height
　　　　　　　ShapRight = .Left + .Width
　　　　　End　With
　　　　

　　　　　'■シート内のオブジェクト全てを確認し、範囲内なら削除
　　　　　For Each OBJ In ActiveSheet.DrawingObjects
　　　　　　　If Not OBJ Is Nothing Then
　　　　　　　　　With　OBJ
　　　　　　　　　　　If ShapTop <= .Top And ShapLeft <= .Left And _
　　　　　　　　　　　　ShapBotom >= .Top + .Height And ShapRight >= .Left + .Width Then
　　　　　　　　　　　　　.Delete
　　　　　　　　　　　End If
　　　　　　　　　End　With
　　　　　　　End　If
　　　　　Next
　　　End　Sub


　（解説）
　　　★「ShapBotom = .Top + .Height」　＝　上位置＋高さ
　　　★「ShapRight = .Left + .Width」　＝　左位置＋幅
　　　★「ShapTop <= .Top」
　　　　　　＝　オブジェクトの上位置が範囲の上位置より下
　　　★「ShapLeft <= .Left」
　　　　　　＝　オブジェクトの左位置が範囲の左位置より右
　　　★「ShapBotom >= .Top + .Height」
　　　　　　＝　オブジェクトの下位置が範囲の下位置より上
　　　★「ShapRight >= .Left + .Width」
　　　　　　＝　オブジェクトの右位置が範囲の右位置より左
　　

　　　※詳しくは下図参照※

　　　

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－


３．指定した文字列があったらその部分だけ文字を装飾する
　　＝　対象セル.Characters(Start:=*, Length:=*).Font.***
　　　　・・・Bold（太字）、ColorIndex（色）、Size（サイズ）など


　（使用例）
　　　'===========================================================
　　　' 指定した部分だけ文字を装飾する
　　　'===========================================================
　　　Sub FontDecoration()
　　　　　Dim LG As Long
　　　　　Dim I As Long
　　　　　Dim J As Long

　　　　　'■最終行まで回して該当したら太字にして文字色を変える
　　　　　LG = Range("A65536").End(xlUp).Row
　　　　　For I = 1 To LG
　　　　　　　'△見ているセルに「ABC」が含まれるか
　　　　　　　If Range("A" & I).Value Like "*ABC*" Then
　　　　　　　　　'◆セルの中のABCの部分を探す
　　　　　　　　　J = InStr(1, Range("A" & I).Value, "ABC")
　　　　　　　　　Range("A" & I).Characters(Start:=J, Length:=3).Font.Bold = True
　　　　　　　　　Range("A" & I).Characters(Start:=J, Length:=3).Font.ColorIndex = 10
　　　　　　　End If
　　　　　Next
　　　End Sub


　（解説）
　　　★「J = InStr(1, Range("A" & I).Value, "ABC")」
　　　　　→Instr(スタート、対象文字列、検索文字列）

　　　★「Range("A" & I).Characters(Start:=J, Length:=3).Font.Bold = True」
　　　　　→Range("A" & I)　＝　A列I行目のセルで
　　　　　→Start:=J　　　　＝　J番目の文字から
　　　　　→Length:=3　　　　＝　3文字分を
　　　　　→Bold = True　　　＝　太字にする
　　　　※ColorIndexの方も同じ意味合い


－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－


1番は作業中に組み込むというよりも使いたいファイルを誰が開いているのか
確認したい場合などに使えますね。
（まあ、サーバーから使用者探す方法が出来る場合はそっちの方が確実ですが）


2番はシート内の全てを一気に消すんでも特定の図形だけを消すんでもないけど
一部分だけ一気に消したい、という時に使えますね。

ちなみに私は実作業でも使いましたし作成途中などでも使いました。
図形の数が多いと便利です。


3番は何かしら検索した結果を目立たせる時などに使えますね。

全部じゃなくて一部だけ装飾したい、って意外にあると思うので
あれば便利かなと思います。