Excel VBAで罫線を引くマクロを書きたい

Excel VBAで罫線を引くマクロを書きたいと思っています。
で、文末のコードを書きました。(というかマクロ記録したものほぼそのもの)
これだとある程度動くのですが、内側線が無いような範囲を選択した場合にはエラーになってしまいます。
内側の線を引く際にIF文をかまさなければならないように思うのですが、イマイチわかりません。
この点について教えてください。
また、コードが冗長であるようにも思えます。もう少しスマートな書き方があればあわせて教えてください。
よろしくお願いします。

Sub 枠線基本()

' 周囲
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

' 内側
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

End Sub

No.1 回答者： Daiki_PaPa 回答日時： 2008/11/25 20:03

単純にエラートラップで回避してみては。

Sub 枠線基本()

' 周囲
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

On Error Resume Next
' 内側
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
On Error GoTo 0

End Sub

この回答へのお礼

>単純にエラートラップで回避してみては。

最初はそうしようかとも思ったのですが、エラーを出すことが前提のコードって、あまりかっこよくない気がしてやめました。

いつか参考にしてみます。ありがとうございました。

お礼日時：2008/11/25 23:08

No.2 ベストアンサー 回答者： fujillin 回答日時： 2008/11/25 21:21

選択範囲の行数が2以上なら内側の水平線を、列数が2以上なら垂直線を引くようにしてあげれば良いのでは？

と思ったら、複数エリアを選択している時にちょいと面倒が・・・
（そんな場合を、想定しなくてもいいのかも知れませんが）

ということで、こんなのでどうでしょうか？
Sub test()
Dim rng As Range
Dim i As Integer

For Each rng In Selection.Areas
'//全部の罫線（内・外とも）
　rng.Borders.LineStyle = xlContinuous
　rng.Borders.Weight = xlThin
　rng.Borders.ColorIndex = xlAutomatic

'//内側の罫線
　For i = 11 To 12
　　If (i = 11 And rng.Columns.Count > 1) Or (i = 12 And rng.Rows.Count > 1) Then
　　　rng.Borders(i).LineStyle = xlContinuous
　　　rng.Borders(i).Weight = xlHairline
　　　rng.Borders(i).ColorIndex = xlAutomatic
　　End If
　Next i
Next rng
End Sub

複数エリアを想定しなければ、外側のループは不要です。

この回答へのお礼

教えていただいたコードをベースに以下のようにアレンジしてみました。
大変助かりました。ありがとうございました。

Sub 枠線基本()

Dim rng As Range

For Each rng In Selection.Areas

' 全部の罫線（内・外とも）
rng.Borders.LineStyle = xlContinuous
rng.Borders.Weight = xlThin
rng.Borders.ColorIndex = xlAutomatic

' 内側の罫線
If (rng.Columns.Count > 1) Then
rng.Borders(xlInsideVertical).Weight = xlHairline
End If
If (rng.Rows.Count > 1) Then
rng.Borders(xlInsideHorizontal).Weight = xlHairline
End If

Next rng
End Sub

お礼日時：2008/11/25 23:04