| |
TAKAさん、こんにちは。
おもしろそうやったんで、作ってみました。
こんなんでどうです？
Sub TEST()
Dim 外枠 As Range
Dim 内枠 As Range
Dim 行位置 As Long
Dim 列位置 As Integer
Dim 大行数 As Integer
Dim 大列数 As Integer
Dim 小行数 As Integer
Dim 小列数 As Integer
Dim I As Integer
Dim J As Integer
Set 外枠 = Application.InputBox(Prompt:="外枠エリアをマウスにて指定して下さい。", Title:="【 マス目作成 】", _
Top:=-80, Type:=8)
Set 内枠 = Application.InputBox(Prompt:="内枠サイズをマウスにて指定して下さい。", Title:="【 マス目作成 】", _
Top:=-80, Type:=8)
行位置 = 外枠.Row
列位置 = 外枠.Column
大行数 = 外枠.Rows.Count
大列数 = 外枠.Columns.Count
小行数 = 内枠.Rows.Count
小列数 = 内枠.Columns.Count
If 大行数 >= 小行数 And 大列数 >= 小列数 And 大行数 Mod 小行数 = 0 And 大列数 Mod 小列数 = 0 Then
For I = 行位置 To 行位置 + 小行数 * (大行数 / 小行数 - 1) Step 小行数
For J = 列位置 To 列位置 + 小列数 * (大列数 / 小列数 - 1) Step 小列数
Range(Cells(I, J), Cells(I + 小行数 - 1, J)).Borders(xlLeft).LineStyle = xlContinuous
Range(Cells(I, J + 小列数 - 1), Cells(I + 小行数 - 1, J + 小列数 - 1)).Borders(xlRight).LineStyle = xlContinuous
Range(Cells(I, J), Cells(I, J + 小列数 - 1)).Borders(xlTop).LineStyle = xlContinuous
Range(Cells(I + 小行数 - 1, J), Cells(I + 小行数 - 1, J + 小列数 - 1)).Borders(xlBottom).LineStyle = xlContinuous
Next
Next
Else
MsgBox "この選択じゃぁ、出来ないよ！"
End If
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
