Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

58435 / 76732

←次へ　｜　前へ→


	【23025】作ってみました。

ぴかる - 05/3/10(木) 11:59 -


	引用なし

	パスワード

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

2 hits

▼

【22970】選択範囲内で等間隔(任意）に罫線を引く TAKA 05/3/9(水) 9:53