Excelで指定した範囲に罫線を引く
表題の通り、Excelの指定した範囲に罫線を引くライブラリがあればいいのになぁと思っているのですが、
スクリプトをご自分で書いて作成された方はいらっしゃらないでしょうか。
もしいらっしゃったらスクリプトを参考にさせていただきたいです。
よろしくお願いします。
この質問は解決済みのためクローズされています。
7melo ベストアンサーとして選択しました
指定した範囲の外周に罫線を引くスクリプトを書いてみました。
ライブラリの「Excel操作(範囲選択)」のスクリプトを書き換えて使用してみてください。
■■■■■■■■■■■■■■■ここからスクリプト文■■■■■■■■■■■■■■■■■■■■■
' ====指定されたファイルを開く====================================================
' ファイルのパスをフルパスに変換する
Set fso = CreateObject("Scripting.FileSystemObject")
filePath = fso.GetAbsolutePathName(!ファイル名!)
' workbookオブジェクトを取得する
Set workbook = Nothing
On Error Resume Next
' 既存のエクセルが起動されていれば警告を抑制する
Set existingXlsApp = Nothing
Set existingXlsApp = GetObject(, "Excel.Application")
existingXlsApp.DisplayAlerts = False
' 一先ずWorkbookオブジェクトをGetObjectしてみる
Set workbook = GetObject(filePath)
Set xlsApp = workbook.Parent
' GetObjectによって新規に開かれたWorkbookなら
' 変数にNothingを代入することで参照が0になるため
' 自動的に閉じられる。
Set workbook = Nothing
' Workbookがまだ存在するか確認する
For Each book In xlsApp.Workbooks
If StrComp(book.FullName, filePath, 1) = 0 Then
' Workbookがまだ存在するので、このWorkbookは既に開かれていたもの
Set workbook = book
xlsApp.Visible = True
End If
Next
' Workbookが存在しない場合は、新たに開く。
If workbook Is Nothing Then
Set xlsApp = Nothing
' Excelが既に開かれていたならそれを再利用する
If Not existingXlsApp Is Nothing Then
Set xlsApp = existingXlsApp
xlsApp.Visible = True
Else
Set xlsApp = CreateObject("Excel.Application")
xlsApp.Visible = True
End If
Set workbook = xlsApp.Workbooks.Open(filePath)
End If
' 警告の抑制を元に戻す
existingXlsApp.DisplayAlerts = True
Set existingXlsApp = Nothing
On Error Goto 0
If workbook Is Nothing Then
Err.Raise 1, "", "指定されたファイルを開くことができません。"
End If
' ====指定されたシートを取得する==================================================
sheetName = !シート名!
Set worksheet = Nothing
On Error Resume Next
' シート名が指定されていない場合は、アクティブシートを対象とする
If sheetName = "" Then
Set worksheet = workbook.ActiveSheet
Else
Set worksheet = workbook.Worksheets(sheetName)
End If
On Error Goto 0
If worksheet Is Nothing Then
Err.Raise 1, "", "指定されたシートが見つかりません。"
End If
worksheet.Activate
' ====指定された範囲をクリップボードへコピー==================================================
scell = !開始セル!
ecell = !終了セル!
range = scell&":"&ecell
On Error Resume Next
cnt = worksheet.range(range).COUNT
On Error Goto 0
'指定された範囲が有効か確認
If cnt = "" Then
Err.Raise 1, "", "指定された範囲が無効です。"
End If
with worksheet.range(range)
.Borders(7).LineStyle = 1 '7=左
.Borders(8).LineStyle = 1 '8=上
.Borders(9).LineStyle = 1 '9=下
.Borders(10).LineStyle = 1 '10=右
end with
' ====終了処理==================================================
Set xlsApp = Nothing
Set existingXlsApp = Nothing
Set ExcelWorkBook = Nothing
Set Excelworksheet = Nothing
Set sheetName = Nothing
Set fso = Nothing
Set filePath = Nothing
KN 新しいコメントを投稿
迅速なご対応ありがとうございます！
頂いたスクリプト文をコピーして問題なく使用できました。
Ctrl+Shift+&で選択セルの外周を囲めることも役に立ちそうです。
大変助かりました、ありがとうございました。
7meloさん
お役に立てて何よりです。
LineStyle = 1 の１を変更することで罫線のスタイルを変更することも可能ですので、一度お試しいただけると良いかと思います。
何度か入力を間違えてしまったので、更新させて頂いた際にメールが届いているかもしれません。申し訳ございません。
本スクリプト文をコピーして、そのままスクリプトに貼り付けていただくことで稼動することを確認しましたので、お試しください。
ちなみにライブラリの範囲選択の後に、キー送信でCtrキー＋Shiftキー＋&キーを送ることで同様に外周に罫線を引くことも可能です。
こちらもお試しください。