開発ツール

・指定したフォルダ内にある複数のExcelファイルにパスワード保護がされているか確認するシステムです。個人情報保護に伴いパスワード保護が必須となるファイルを全てチェックできるシステムです。

 

・年間カレンダー作成ツールです。公開ソースコードですので、お使いの業務に合わせてカスタマイズしてください。

 

・文字などの上に引く二重取り消し線を実行するロジック(基本)です。2019/06/26

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Myrng As Range
Dim Mycenter As Single, Myleft As Single, Myright As Single

Cancel = True
Set Myrng = Target

Mycenter = Myrng.Top + Myrng.Height / 2
Myleft = Myrng.Left
Myright = Myrng.Left + Myrng.Width

With ActiveSheet.Shapes.AddLine(Myleft, Mycenter, Myright, Mycenter).Line
.Style = msoLineThinThin
.Weight = 4.5
.ForeColor.ObjectThemeColor = msoThemeColorText1
End With

‘ With ActiveSheet.Shapes.AddLine(Myleft, Mycenter, Myright, Mycenter).Line
‘ .Style = msoLineThinThin
‘ .Weight = 3#
‘ End With

End Sub

 

・文字などの上に引く二重取り消し線を実行するロジック(応用)です。2019/06/26

Sub sub_二重取り消し線を引く()
Dim Myrng As Range
Dim Mycenter As Single, Myleft As Single, Myright As Single

Set Myrng = Range(“C7”)

Mycenter = Myrng.Top + Myrng.Height / 2
Myleft = Myrng.Left
Myright = Myrng.Left + Myrng.Width

With ActiveSheet.Shapes.AddLine(Myleft, Mycenter, Myright, Mycenter).Line
.Style = msoLineThinThin
.Weight = 4.5
.ForeColor.ObjectThemeColor = msoThemeColorText1
End With

‘ With ActiveSheet.Shapes.AddLine(Myleft, Mycenter, Myright, Mycenter).Line
‘ .Style = msoLineThinThin
‘ .Weight = 3#
‘ End With

End Sub

 

・マクロ実行時にファイルがフリーズしてしまう時の回避ロジックです。

Option Explicit

‘—ワークブックを開く時のイベント
Private Sub Workbook_Open()
ActiveWindow.ScrollRow = 1

MsgBox “他のExcelファイルを閉じます。”
Call sub_他のExcelファイルを閉じる

Call Hozon

End Sub

 

Option Explicit

‘##########################################################################
‘これを最初に一度実行すれば、あとは1分ごとに自動的に呼び出されます。
‘標準モジュールに書いてください。
‘##########################################################################

Sub Hozon()

Call sub_バックアップファイル作成
Application.OnTime Now + TimeValue(“00:01:00”), “Hozon”

End Sub

Sub sub_他のExcelファイルを閉じる()
Dim myBK As Workbook

Application.DisplayAlerts = False ‘—保存の同意を表示しない
If Workbooks.Count > 1 Then ‘—ブックが複数開かれているか判定
MsgBox “このマクロが実行されているファイル以外のExcelファイルは保存して閉じます。”
For Each myBK In Workbooks
If myBK.Name <> ActiveWorkbook.Name Then ‘—Excelファイル名を判定して現在選択しているbook(ActiveWorkbook)以外の名前のブックを閉じる
myBK.Save ‘—保存する
myBK.Close ‘—ブックを閉じる
End If
Next
End If
Application.DisplayAlerts = True ‘—保存の同意を表示する

End Sub

Sub sub_バックアップファイル作成()
Dim パス As String
Dim ファイル名 As String

パス = ThisWorkbook.Path
ファイル名 = Format(Now(), “yyyymmdd”) & “_” & Format(Now(), “hhmmss”) & “_” & ThisWorkbook.Name
ThisWorkbook.SaveCopyAs Filename:=パス & “\Backup\” & ファイル名

End Sub

Sub sub_バックアップファイルをすべて削除()
Dim Folder_Path, FileName_InFolder As String
Dim buf As String

‘—フォルダのパスを取得
Folder_Path = ThisWorkbook.Path & “\Backup”

buf = Dir(Folder_Path & “\*.*”)

‘—フォルダ内のすべてのファイル指定
FileName_InFolder = Folder_Path & “\*.*”

If buf <> “” Then
‘—ファイルの削除
Kill FileName_InFolder
Else
MsgBox “バックアップファイルは存在しませんでした。”
End If

End Sub