Range.BorderAroundメソッド[Excel]～車輪の再発明
車輪の再発明
Range.BorderAroundメソッド
前回の
に、 ぴぼったー さんからコメントをいただいた。曰く、
つ borderaroundメソッド
なんと、外枠線を引くメソッドがあったのだった。
またしても車輪の再発明をしてしまったのだった。
使ってみた
気を取り直して、Range.BorderAroundメソッドを使ってみる。
リスト１ 標準モジュール
Public Sub testBorderAround()
Dim targetRange As Range
Set targetRange = Selection
Call targetRange.BorderAround(LineStyle:=xlContinuous, _
Weight:=xlMedium, _
ColorIndex:=xlColorIndexAutomatic)
End Sub
選択範囲の外枠に罫線を引く、というだけのコード。
別に
Selection.BorderAround
と書いても良いが、一旦
Set targetRange = Selection
このようにRange型変数に突っ込んでおくことで、
こんなふうにintellisenseが効くので楽。
実行結果
この状態で実行。
ほれ、この通り。簡単に外枠線が引けた。
おわりに
ぴぼったー さん、毎度ありがとうございました。
セル範囲の外枠に罫線を引く[Excel]
セル範囲の外枠罫線
VBAでセルの罫線の設定なんてしたことがなかったので知らなかったが、セル範囲の外枠だけに罫線を設定するのは非常にメンドクサイのだった。
セルの罫線はRangeオブジェクト配下のBordersコレクションで管理されている。
で、罫線の位置を指定する場合は、
Range.Borders(インデックス値)
の形でインデックスを指定してやればよい。
インデックス値は定数が設定されていて、
このように、「XlBordersIndex」という列挙体にまとめられている。
で、このインデックス値を省略すると、格子状に指定したのと同じになる。
私も、単純に罫線を引くだけのことならよくやっていて、
[Rangeオブジェクト式].Borders.LineStyle = xlContinuous
みたいなコードはしょっちゅう書いていたので、それこそ何も見ないでも書けるが、【セル範囲の外枠にだけ罫線を設定する】という場面に出くわして、「あれ、どうやるんだっけ？」となったのであるｗ
セルの外枠にだけ罫線を引く
徹底的に調べたわけではないので、実は簡単なやり方があるのかもしれないが、どうも、
[Rangeオブジェクト式].Borders(xlEdgeTop).LineStyle = xlContinuous [Rangeオブジェクト式].Borders(xlEdgeRight).LineStyle = xlContinuous [Rangeオブジェクト式].Borders(xlEdgeLeft).LineStyle = xlContinuous [Rangeオブジェクト式].Borders(xlEdgeBottom).LineStyle = xlContinuous
というやり方になるみたい。線の太さや色の設定を省略してもこのコード。めんどくさすぎる。
手作業ならツールバーのアイコンクリック一発なのにｗ
というわけで、メソッド化してみた。
drawEdgeLinesメソッドの自作
まずはコードの紹介。
リスト１ 標準モジュール
Option Explicit
Private Type BorderStyle '……(1)'
LineStyle_ As XlLineStyle
Weight_ As XlBorderWeight
ColorIndex_ As XlColorIndex
End Type
Public Sub drawEdgeLines(
ByVal targetRange As Range, _
Optional ByVal kindOfLineStyle As XlLineStyle = xlContinuous, _
Optional ByVal kindOfWeight As XlBorderWeight = xlThin, _
Optional ByVal kindOfColorIndex As XlColorIndex = xlAutomatic) '……(2)'
Dim borderStyle_ As BorderStyle '……(3)'
With borderStyle_
.LineStyle_ = kindOfLineStyle
.Weight_ = kindOfWeight
.ColorIndex_ = kindOfColorIndex
End With
With targetRange '……(4)'
Call setBorderStyle(.Borders(xlEdgeBottom), borderStyle_)
Call setBorderStyle(.Borders(xlEdgeLeft), borderStyle_)
Call setBorderStyle(.Borders(xlEdgeRight), borderStyle_)
Call setBorderStyle(.Borders(xlEdgeTop), borderStyle_)
End With
End Sub
Private Sub setBorderStyle(ByVal targetBorder As Border, _
ByRef borderStyle_ As BorderStyle) '……(*)'
With targetBorder
.LineStyle = borderStyle_.LineStyle_
.Weight = borderStyle_.Weight_
.ColorIndex = borderStyle_.ColorIndex_
End With
End Sub
まずは(1)の
Private Type BorderStyle LineStyle_ As XlLineStyle Weight_ As XlBorderWeight ColorIndex_ As XlColorIndex End Type
１つの罫線につき、３種類の設定（線の種類・太さ・色）があるので、ひとまとめの構造体にした。他から呼び出して使うようなものでもないので、Private指定。
(2)の
Public Sub drawEdgeLines(
ByVal targetRange As Range, _
Optional ByVal kindOfLineStyle As XlLineStyle = xlContinuous, _
Optional ByVal kindOfWeight As XlBorderWeight = xlThin, _
Optional ByVal kindOfColorIndex As XlColorIndex = xlAutomatic)
でメソッド本体の引数設定。
長ったらしく見えるので軽く引くかもｗ
第１引数targetRangeは枠線を設定したいセル範囲。
第２引数kindOfLineStyleは線の種類。「XｌLineStyle」型にしているので、入力時にintellisenseが効く。「オブジェクト・ブラウザー」の使い方が分かってくると、こういう便利な引数指定ができるようになる。
第３引数kindOfWeightは線の太さ。
第４引数kindOfColorIndexは線の色。
(3)からの６行
Dim borderStyle_ As BorderStyle With borderStyle_ .LineStyle_ = kindOfLineStyle .Weight_ = kindOfWeight .ColorIndex_ = kindOfColorIndex End With
で、自作構造体BorderStyleに引数で受け取った罫線の設定をぶち込む。
VBAでは小文字と大文字を区別しないので、BorderStyle型の変数名として「borderStyle」というのが使えない。とはいえ、BorderStyle型というのは自作型で、なおかつ１つしか使わないことが明白なので、変数名を「borderStyle」にしておきたい。そんなわけで、苦し紛れの策としてアンダースコアを付けて「borderStyle_」とした。
Person person = new Person();
って書きたいなあ。VBA大好きだけれど、こういうところが不便。
(4)からの６行
With targetRange Call setBorderStyle(.Borders(xlEdgeBottom), borderStyle_) Call setBorderStyle(.Borders(xlEdgeLeft), borderStyle_) Call setBorderStyle(.Borders(xlEdgeRight), borderStyle_) Call setBorderStyle(.Borders(xlEdgeTop), borderStyle_) End With
いちいち似たようなコードを４回も書かないといけないので、こんなふうに１箇所にまとめた。
「setBorderStyle」というメソッドを引数を変えて４回読んでいるが、これも自作メソッドで、(*)の
Private Sub setBorderStyle(ByVal targetBorder As Border, _
ByRef borderStyle_ As BorderStyle)
With targetBorder
.LineStyle = borderStyle_.LineStyle_
.Weight = borderStyle_.Weight_
.ColorIndex = borderStyle_.ColorIndex_
End With
End Sub
がそれ。BorderStyle型の引数（罫線の３種類の設定が全部入っている）を受け取って、線を引くだけのメソッド。
これで、細い実線をセル範囲の四方に引くだけなら、
Call drawEdgeLines([Rangeオブジェクト式])
だけでおｋ、ということになる。
使ってみた
画面上でこんなふうに範囲選択をして、次のコードを実行。
リスト２ 標準モジュール
Public Sub testDrawEdgeLines()
Call drawEdgeLines(targetRange:=Selection, _
kindOfLineStyle:=xlContinuous, _
kindOfWeight:=xlMedium)
End Sub
一応引数は４つ中３つ渡した。
中太実線を選択範囲に引け、という命令。
この通り、無事に外枠罫線が設定された。
おわりに
外枠罫線だけを一発で引く方法ってあるのかしら？
それと、Bordersの引数を省略したときに「格子」になるようにしたのはさすが。
Bordersの引数を省略して「Bordersコレクションだョ全員集合！」みたいな設定だったら、VBAerはみんな発狂すると思うｗ
追記
なお、今回の記事は、単なる「車輪の再発明」に過ぎないこと、申し添えますｗ
ナゾの書式設定文字列（Range.NumberFormatLocalプロパティ）
ナゾの書式設定文字列「;;;」
前回の
こちらに、 ぴぼったー さんという方からコメントをいただいた。曰く、
本日のサンプルのパターン、
（要望）列方向に連続する場合に表記を省略する
（実装）セルの結合を行う
（Excel屋の本音）結合はマクロの邪魔になるからやめろぉ！
って場合、
A1＝愛知,A2＝愛知,A3＝愛知と入力されたセルに対して
A2・A3をの値を見かけ非表示にする
With Range("A1") .NumberFormatLocal="" .Borders(xlEdgeBottom).LineStyle = xlNone End With With Range("A2") .NumberFormatLocal=";;;" .Borders(xlEdgeBottom).LineStyle = xlNone End With With Range("A3") .NumberFormatLocal=";;;" .Borders(xlEdgeBottom).LineStyle = xlContinuous End Withこんな感じの処理を組んだことがあります。
へえ。ちょっとやってみよう。
やってみた
こんなシートを用意し、
次のコードを実行する。
リスト１ 標準モジュール
Public Sub dummyMergeCells()
With Range("A1")
.NumberFormatLocal = ""
.Borders(xlEdgeBottom).LineStyle = xlNone
End With
With Range("A2")
.NumberFormatLocal = ";;;"
.Borders(xlEdgeBottom).LineStyle = xlNone
End With
With Range("A3")
.NumberFormatLocal = ";;;"
.Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
End Sub
実行結果
おおっ！
Ａ２セルとＡ３セルの「ち～んｗ」が消えとる！！！！
んでも、
Ａ２セル、Ａ３セルともに「ち～んｗ」という値はあるのに！！！！
おわりに
書式設定文字列（？）の「;;;」って何者？？？
同じ値の連続するセルを結合する[Excel](Range.Mergeメソッド)
同じ値の連続するセルを結合する
Excelは、表計算ソフトとしてよりも、方眼紙として使われているケースが多いと思う。
そこで、大活躍するのが（ｗ）セルの結合機能だと思う。
多くのExcel使いは、データを蓄積するためのシートで見栄えをよくするためにセルの結合を多用しやがるので、Excelをフツーに使いたい私のような善良な市民はいつも迷惑をこうむるわけですｗ
それでもまあ、見栄えを整えるために連続する同じ値のセルを結合する、という操作はそれなりに発生するので、自動化してみようと考えた。
考え方
とりあえず、タテ方向１列限定で考えてみた。複数列複数行はなかなか大変そうなので、ひとまず保留。
処理の手順
指定した範囲の一番上のセルから順に下へ下へと進めていく。
- 同じ値のセルが連続していたら、先頭のセルを変数に格納し、同じ値のセルがいくつ続くかカウントする
- 異なる値のセルにぶつかった時点で、Resizeプロパティを用いて同じ値のセル領域を取得し、結合する
とまあ、このような手順を考えた。
コーディング
リスト１ 標準モジュール
Public Sub mergeSameValueCells(ByVal targetRange As Range)
If targetRange.Columns.Count > 1 Then _
Call makeUserSick("２列以上の範囲を渡すなぼけー！"): Exit Sub
Dim cnt As Long
Dim targetCell As Range
Dim tmpCell As Range
Dim isToBeMerged As Boolean '……(1)'
cnt = 1
For Each targetCell In targetRange
With targetCell
If Not isToBeMerged Then '……(2)'
If .Value = .Offset(1, 0).Value Then '……(3)'
Set tmpCell = targetCell
cnt = cnt + 1
isToBeMerged = True
Else '……(4)'
Set tmpCell = targetCell
tmpCell.HorizontalAlignment = xlCenter
tmpCell.VerticalAlignment = xlCenter
End If
Else '(If isToBeMerged Then)' '……(5)'
If .Value = .Offset(1, 0).Value Then '……(6)'
cnt = cnt + 1
Else '(If .Value <> .Offset(1, 0).Value)' '……(7)'
Application.DisplayAlerts = False
tmpCell.Resize(cnt, 1).Merge
Application.DisplayAlerts = True
tmpCell.HorizontalAlignment = xlCenter
tmpCell.VerticalAlignment = xlCenter
isToBeMerged = False
cnt = 1
End If
End If
End With
Next
End Sub
とりあえず一通り書いてみただけなので、ちょっとクソコードｗ
１列のセル範囲を受け取って処理する想定。
したがって、引数で受け取ったセル範囲が複数列だったら、最初のところで何もせずにreturnしている。
まず、(1)の
Dim isToBeMerged As Boolean
はフラグ変数。ざっくりと言えば、セル連結モードになっているかどうかを表す変数。
isToBeMergedがTrueのときは同じ値のセルを数えている途中、と考えてもらえば良い。
んで、メインの処理。まずは(2)からの23行（！）
If Not isToBeMerged Then If .Value = .Offset(1, 0).Value Then '……(3)' Set tmpCell = targetCell cnt = cnt + 1 isToBeMerged = True Else '……(4)' Set tmpCell = targetCell tmpCell.HorizontalAlignment = xlCenter tmpCell.VerticalAlignment = xlCenter End If Else '(If isToBeMerged Then)' '……(5)' If .Value = .Offset(1, 0).Value Then '……(6)' cnt = cnt + 1 Else '(If .Value <> .Offset(1, 0).Value)' '……(7)' Application.DisplayAlerts = False tmpCell.Resize(cnt, 1).Merge Application.DisplayAlerts = True tmpCell.HorizontalAlignment = xlCenter tmpCell.VerticalAlignment = xlCenter isToBeMerged = False cnt = 1 End If End If
まず、isToBeMergedがFalseのとき、すなわち、同じ値のセルを数える体勢になっていない状態のときには、(3)からの９行に処理が移る。
If .Value = .Offset(1, 0).Value Then Set tmpCell = targetCell cnt = cnt + 1 isToBeMerged = True Else '……(4)' Set tmpCell = targetCell tmpCell.HorizontalAlignment = xlCenter tmpCell.VerticalAlignment = xlCenter End If
まず、１つ下のセルと値を比較して同じ値だったら、targetCellをtmpCellにぶち込んで、cntをインクリメントし、isToBeMergedをTrueにする。これで同じ値のセルを数えるモードに切り替えたことになる。
１つ下のセルと異なる値であったならば、このセルは結合する必要がないということだから、(4)のElseブロックを実行して、値のセンタリングだけしておく。
次に、isToBeMergedがTrueのとき、すなわち、すでに同じ値のセルを数える体勢に入っているときは、(5)から下の11行に処理が移る。
If .Value = .Offset(1, 0).Value Then '……(6)' cnt = cnt + 1 Else '(If .Value <> .Offset(1, 0).Value)' '……(7)' Application.DisplayAlerts = False tmpCell.Resize(cnt, 1).Merge Application.DisplayAlerts = True tmpCell.HorizontalAlignment = xlCenter tmpCell.VerticalAlignment = xlCenter isToBeMerged = False cnt = 1 End If
(6)で１つ下のセルと値を比較し、同じ値だったら、cntをインクリメントするだけで良い。
１つ下のセルと異なる値だったら、セルを結合しなければならないので、(7)からの７行の処理を行う。
Application.DisplayAlerts = False tmpCell.Resize(cnt, 1).Merge Application.DisplayAlerts = True tmpCell.HorizontalAlignment = xlCenter tmpCell.VerticalAlignment = xlCenter isToBeMerged = False cnt = 1
まず、セルを結合するときには一番左上の値しか残らないとか何とか警告メッセージが出るので、Application.DisplayAlertsをFalseにしておく。
次に、tmpCell（同じ値のセルを数え始めたときの最初のセル）のResizeプロパティに引数としてcnt（同じ値のセルの個数）を渡して同じ値の連続するセル範囲を取得し、Mergeメソッドで結合。即座にApplication.DisplayAlertsをTrueに戻しておく。
後は、HorizontalAlignmentプロパティとVerticalAlignmentプロパティの値をxlCenterに設定して中央寄せにし、isToBeMergedをFalseにしてモードをリセットしておく。
これをFor Eachで回す、という算段。
使ってみた
次のコードで実験。
リスト２ 標準モジュール
Public Sub testMergeSameValueCells() Call mergeSameValueCells(Selection) End Sub
選択範囲を引数として渡してmergeSameValueCellsを実行するだけのコード。
まずはこんな表を用意して、
この状態で実行。
ほれ、この通り。
ついでに、
こんな表でもやってみた。
バッチリです。
おわりに
とりあえず組み立ててみただけなので、そもそものロジック含め、まだまだ改良の余地がありそう。
Excelを方眼紙的に使うことを止めるだけの力はないので、各個撃破で対抗するしかないのよね……。
追記
重大な欠陥があったので、メソッドを作り直しました。
isAutoFilteredメソッドの修正
isAutoFilteredメソッドの欠陥
isAutoFilteredメソッドとは
自作のFunction。
このときに作ったもの。
こんなふうにフィルターで絞り込まれていないときにFalseを返す。
イミディエイト・ウインドウに
?isAutoFiltered(Sheet1)
と入力して[Enter]を押すと、
このとおり。
こんなふうに、フィルターで絞り込まれていると、Trueを返す。
このとおり。
重大な欠陥
しかし、このisAutoFilterメソッドには、重大な欠陥があったのだった。
AutoFilterオブジェクトのことが分かっている方は、すでにお気づきだったかと思うが、たとえば、
この状態のワークシートを指定して
実行しようと[Enter]を押すと、
実行時エラーになる。
理由は簡単。
そもそもAutoFilterオブジェクトが存在しないのに参照しようとしたからだ。
今でこそエラーメッセージを見た瞬間、このことに気づけたけれど、初心者の頃だったらこれだけで小一時間はハマっていたと思うｗ
というわけで、コードを修正した。
修正後のコード
リスト１ 標準モジュール
Public Function isAutoFiltered(Optional ByVal targetSheet As Worksheet) As Boolean
If targetSheet Is Nothing Then Set targetSheet = ActiveSheet
With targetSheet
If .AutoFilter Is Nothing Then isAutoFiltered = False: Exit Function '……(*)'
If .AutoFilter.FilterMode Then isAutoFiltered = True: Exit Function
End With
isAutoFiltered = False: Exit Function
End Function
変えたのは、基本的には(*)のところだけ。
対象のワークシートにAutoFilterオブジェクトがなかったらFalseをreturnして処理を抜ける、というだけ。
使ってみる
改めて[Enter]！
ちゃんとFalseが返った。
おわりに
フィルターを設定した状態で作成したFunctionだったので、フィルターを外した状態での実験が完全に抜けていた。とらわれるとやはり見落とすことが多いものです。
半角カタカナを全角ひらがなに変換する（StrConv関数）
半角カタカナと戦う（StrConv関数）
名簿のふりがな欄
いろんな名簿を作る必要があって、着手してから気がついた。
名簿のふりがな欄、ふりがなの付け方めちゃくちゃやんけ！
ある名簿は全角ひらがな。またある名簿は半角カタカナ。
んで、StrConv関数を使ってみた。
半角カタカナを全角ひらがなにできるか
やってみた。
イミディエイト・ウインドウに、
?StrConv("ﾗﾙﾌ･ﾌﾞﾗｲｱﾝﾄ",vbHiragana)
と入力して[Enter]！
全然ダメｗｗｗ
半角カタカナを全角カタカナにできるか
こんどは、
?StrConv("ﾗﾙﾌ･ﾌﾞﾗｲｱﾝﾄ",vbWide)
と入力して[Enter]！
おお！ 半角カタカナから全角カタカナというのはできるようだ。ありがたい。
ちゃんと「ﾌﾞ」（２文字）が「ブ」（１文字）になっとるし。
一旦全角カタカナにしてから全角ひらがなへ
全角カタカナから全角ひらがなならフツーにできると思うので、
?StrConv(StrConv("ﾗﾙﾌ･ﾌﾞﾗｲｱﾝﾄ",vbWide),vbHiragana)
これで大丈夫のはず。
[Enter]！
やはり。
半角カタカナを全角ひらがなに変換するFunction
作ってみた。
リスト１ 標準モジュール
Public Function convertSingleByteKatakanaToDoubleByteHiragana _
(ByVal targetString As String) As String
Dim tmp As String
tmp = StrConv(targetString, vbWide)
tmp = StrConv(tmp, vbHiragana)
convertSingleByteKatakanaToDoubleByteHiragana = tmp
End Function
プロシージャ名が無駄に長い。
まあ、いったん全角文字に変えてから、ひらがなに変換してreturnしているだけの簡単なFunction。
使ってみた
イミディエイト・ウインドウに
?convertSingleByteKatakanaToDoubleByteHiragana("ﾌﾗﾝｼｽ･ﾌﾞｯﾌﾎﾙﾂ")
と入力して[Enter]！
ほれ、この通り。
おわりに
半角カタカナを全角カタカナに変換できるんなら、半角カタカナを直接全角ひらがなに変換できても良さそうなものだけれど、〈半角→全角〉、という処理と〈カタカナ→ひらがな〉という処理を分けておくことに意義があるのでしょうなあ。
Document_Closeイベントで差込データソースとの接続を切断する
Document_Closeイベントの挙動
差し込み印刷の設定をしているドキュメントは、一旦閉じると、次回起動時に自動的に前回接続していたデータソースに接続しようとする。
これはこれで親切機能なのだが、何も知らない人が差し込み設定をしたドキュメントを別のフォルダに移動したりした日には大パニックが起こること必定であるｗ
また、差し込み設定のことがよく分かっている人間でも、たとえば前年度のものを使い回すのにフォルダごと移動したようなとき、その都度差し込み設定をやり直すのはちょいメンドクサイ。
そんなこともあって、
こういうのを作ったわけだが、実はコレも不十分だった。
Openイベントで一旦接続を切るようにしたとしても、Openイベントが発生する前にデータソースを探しに行っているっぽいので、全然解決になっていないことに気づいたのだ。
これはやはりCloseイベントで対応しないといけないと分かった。
ドキュメントClose時にデータソースを切断するイベントマクロ
細かい説明は後にして、とりあえずの完成形を示す。
リスト１ ThisDocumentモジュール
Private Sub Document_Close()
Dim Doc As Document
Set Doc = ThisDocument
With Doc
If .Saved Then '……(1)'
Call disconnectMailMergeDataSource(Doc) '……(2)'
.Save '……(3)'
Else
Call disconnectMailMergeDataSource(Doc) '……(4)'
End If
End With
End Sub
まず、(1)からの６行
If .Saved Then Call disconnectMailMergeDataSource(Doc) '……(2)' Call .Save '……(3)' Else Call disconnectMailMergeDataSource(Doc) '……(4)' End If
では、ドキュメントのSavedプロパティによって条件分岐している。
SavedプロパティがTrue、すなわち既に上書き保存された状態であれば、(2)の
Call disconnectMailMergeDataSource(Doc)
で、まずdisconnectMailMergeDataSourceメソッドを呼んで接続をぶった切る。
ちなみに、disconnectMailMergeDataSourceメソッドのコードはコチラ。
で、(3)の
Call .Save
で再度上書き保存をする。ドキュメントClose時点で上書き保存済みであり、その後の変更はデータソースの切断だけなので、再度上書き保存してもユーザーに不利益は生じないはず。これでデータソースが切断された状態で保存されているはずだ。
で、SavedプロパティがFalseのとき、すなわち上書き保存せずにドキュメントCloseしようとしたときにも(4)の
Call disconnectMailMergeDataSource(Doc)
でデータソースをぶった切っている。
なぜこんなことが必要なのか。
次の画像を見てほしい。
SavedプロパティがFalseの状態、すなわち変更を保存していない状態でドキュメントを閉じようとしてみる。
上書き保存をせずに（すなわちSavedプロパティがFalseの状態で）Document_Closeイベントが発生すると、このような順でプロシージャが実行され、そのあとで
コイツが出てくるのだ。
つまり、もしCloseイベントの中でデータソースをぶった切っておかないと、上書き保存確認ダイアログで[保存]を選んだ場合にデータソースに接続された状態で保存されてしまうわけ。
おわりに
これで少なくともWord2013では「常に差込データソースを切断した状態に保つ」ことができるようになった。
ただ、職場のWord2010だと、Closeイベント内で 切断→上書き保存 をしても、接続状態なんだよなあ……。
