他ブックへのリンクエラーを探し解除するマクロ（変更前）
掲載しているVBAコードの最初に掲載したものになります。
どのように変更したかを比べてみると、プロシージャー分割やプログラムのブラッシュアップ過程の参考になると思います。
Option Explicit
'定数
Private Const NmTargetBook As String = "nmTargetBook" '対象ブック指定のセル
Private Const NmCntMax As String = "nmCntMax" '表示最大件数のセル
Private Const StartErrRow As Long = 5 '出力シートの開始行
'出力文字列定数
Private Const Cns数式 As String = "数式"
Private Const Cns名前定義 As String = "名前定義"
Private Const Cns条件書式 As String = "条件書式"
Private Const Cns入力規則 As String = "入力規則"
Private Const Cnsマクロ登録 As String = "マクロ登録"
Private Const Cnsバツ As String = "×"
Private Const Cns三角 As String = "△"
Private Const Cnsする As String = "する"
Private Const Cnsしない As String = "しない"
Private Const Cns削除済 As String = "削除済"
'変数
Private Wb As Workbook '検索対象ブック
Private Ws As Worksheet '検索対象シート
Private WsErr As Worksheet '出力シート
Private ErrMsg As String '保存用エラーメッセージ
Private CntAll As Long '確認するセル数
Private CntLink As Long '外部リンク数
Private CntErr As Long 'リンクエラー数
Private CntPend As Long '保留リンク数
Private CntDel As Long '削除数
Private CntMax As Long '表示最大件数
Private HoldAddress As String 'セル範囲統合中のアドレス
Private CntHold As Long 'セル範囲統合中の件数
'列挙
Private Enum Col '出力シートの列位置
種別 = 1
場所 = 2
詳細 = 3
判定 = 4
削除 = 5
End Enum
'### リンクエラー検索のメイン処理 ###
Public Sub SearchErrorLink()
Dim rng1 As Range
Dim rng2 As Range
Dim nm As Name
Dim fcds As FormatConditions
Dim fcd As FormatCondition
Dim vdt As Validation
Dim sp As Shape
Dim i As Long, j As Long
Dim sTemp As String
Dim StartTime As Date
Set WsErr = ActiveSheet 'リンクエラー検索
'チェック対象ブック選択
With WsErr
.Unprotect 'シート保護解除
Set Wb = frmSelectBook.DoModal(.Range(NmTargetBook))
If Wb Is Nothing Then
.Protect
Exit Sub
End If
ThisWorkbook.Activate
End With
'開始処理
StartTime = Now()
Application.Cursor = xlWait
CntAll = 0: CntLink = 0: CntErr = 0: CntPend = 0: CntDel = 0
HoldAddress = "": CntHold = 0
WsErr.Unprotect
j = 0
On Error Resume Next
'エラー出力先を準備
With WsErr
CntMax = .Range(NmCntMax)
Set rng1 = .Cells.SpecialCells(xlCellTypeLastCell)
If rng1.Row >= StartErrRow Then
.Range(.Cells(StartErrRow, "A"), rng1).Clear
End If
.Range(.Columns(Col.場所), .Columns(Col.詳細)).NumberFormatLocal = "@"
.Range(.Columns(Col.場所), .Columns(Col.詳細)).WrapText = True
.Range(.Columns(Col.判定), .Columns(Col.削除)).Font.Bold = True
.Range(.Columns(Col.判定), .Columns(Col.削除)).HorizontalAlignment = xlCenter
Application.GoTo .Cells(StartErrRow, Col.種別), True
End With
'数式
For Each Ws In Wb.Worksheets
Call DispStatusBar("数式のチェック中：" & Ws.Name)
Set rng1 = Ws.Cells.SpecialCells(xlCellTypeFormulas)
If Err Then
Err.Clear
Else
For Each rng2 In rng1
If rng2.Formula Like "*[[]*[]]*[!]*" Then
If setError(rng2) Then GoTo FinalExit
End If
Call EventForEachCount
Next
End If
Next
'名前定義
Call DispStatusBar("名前定義のチェック中：")
DoEvents
For Each nm In Wb.Names
If nm.RefersTo Like "*[[]*[]]*[!]*" Then
If setError(nm) Then GoTo FinalExit
End If
Call EventForEachCount
Next
'条件付き書式
For Each Ws In Wb.Worksheets
Call DispStatusBar("条件付き書式のチェック中：" & Ws.Name)
DoEvents
Set rng1 = Ws.Cells.SpecialCells(xlCellTypeAllFormatConditions)
If Err Then
Err.Clear
Else
For Each rng2 In rng1
Set fcds = rng2.FormatConditions
For i = fcds.Count To 1 Step -1
'「数式を使用して…」のみ対象
If TypeName(fcds(i)) = "FormatCondition" Then
Set fcd = fcds(i)
If fcd.Formula1 Like "*[[]*[]]*[!]*" Then
'Parentからセルを取得するためコレクションを渡す
If setError(fcds, i) Then GoTo FinalExit
End If
End If
Call EventForEachCount
Next
Next
End If
Next
'入力規則
For Each Ws In Wb.Worksheets
Call DispStatusBar("入力規則のチェック中：" & Ws.Name)
Set rng1 = Ws.Cells.SpecialCells(xlCellTypeAllValidation)
If Err Then
Err.Clear
Else
For Each rng2 In rng1
Set vdt = rng2.Validation
If vdt.Formula1 & vdt.Formula2 Like "*[[]*[]]*[!]*" Then
If setError(vdt) Then GoTo FinalExit
End If
Call EventForEachCount
Next
End If
Next
'オブジェクトの登録マクロ
For Each Ws In Wb.Worksheets
Call DispStatusBar("登録マクロのチェック中：" & Ws.Name)
DoEvents
For Each sp In Ws.Shapes
If Left(sp.Name, 9) <> "Drop Down" Then
sTemp = sp.OnAction
If Err Then
Err.Clear
Wb.Activate
Ws.Select
sTemp = sp.OnAction
If Err Then
Err.Clear
sTemp = ""
End If
ThisWorkbook.Activate
End If
If sTemp Like "*[!]*" Then
If InStr(sp.OnAction, Wb.Name & "!") <> 1 Then
If setError(sp) Then GoTo FinalExit
End If
End If
End If
Call EventForEachCount
Next
Next
j = -1
FinalExit: '途中でエラーがあった時の飛び先
If j = 0 Then
MsgBox "処理中で問題が発生しました。" & vbLf & _
"途中からは処理がスキップされています。" & vbLf & vbLf & _
Application.StatusBar & vbLf & _
ErrMsg & vbLf & vbLf & _
Err.Description, vbExclamation
End If
'エラー出力シートを設定
ThisWorkbook.Activate
With WsErr
.Select
j = .Cells(.Rows.Count, 1).End(xlUp).Row
'セル範囲アドレスの出力残
If CntHold > 0 Then .Cells(j, Col.場所) = HoldAddress
'「削除」に入力規則設定
With .Range(.Cells(StartErrRow, Col.削除), .Cells(j, Col.削除))
.Validation.Add Type:=xlValidateList, Formula1:=Cnsする & "," & Cnsしない
.Interior.Color = XlRgbColor.rgbFloralWhite
.Locked = False
End With
'罫線設定
.Cells(StartErrRow - 1, Col.種別).CurrentRegion.Borders.LineStyle = xlContinuous
For i = StartErrRow To j
If .Cells(i, Col.種別) <> .Cells(i - 1, Col.種別) Then
.Range(.Cells(i, Col.種別), .Cells(i, Col.削除)).Borders(xlEdgeTop).LineStyle _
= XlLineStyle.xlDouble
End If
Next
'条件付き書式と入力規則は、リンク先の存否にかかわらず削除対象
For i = 5 To j
If .Cells(i, Col.判定) = Cnsバツ Or _
.Cells(i, Col.種別) = Cns条件書式 Or _
.Cells(i, Col.種別) = Cns入力規則 Then
If .Cells(i, Col.削除) = "" Then
.Cells(i, Col.削除) = Cnsする
End If
End If
Next
Application.GoTo .Cells(StartErrRow, Col.種別), True
.Protect 'シート保護
End With
'終了処理
On Error GoTo 0
Application.StatusBar = False
Application.Cursor = xlDefault
MsgBox "チェック完了しました。" & vbLf & vbLf & _
"処理時間=" & CDate(Now() - StartTime) & vbLf & vbLf & _
"確認したセル数 = " & Format(CntAll, "#,##0") & vbLf & _
" 外部リンク数 = " & Format(CntLink, "#,##0") & vbLf & _
" エラーリンク数 = " & Format(CntErr, "#,##0") & vbLf & _
" 保留リンク数 = " & Format(CntPend, "#,##0"), _
vbOKOnly, "結果表示"
End Sub
'### 見つけた他ブックのリンクに対する処理 ###
Private Function setError(ByVal obj As Object, _
Optional ByVal i As Integer = 0) _
As Boolean
Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range
Dim nm As Name
Dim fcds As FormatConditions
Dim vdt As Validation
Dim sp As Shape
Dim myArray(1 To 1, Col.種別 To Col.判定)
Dim errRow As Long
setError = True
If Err Then Exit Function '呼び出し元でエラーが出ている場合
With WsErr
Select Case TypeName(obj)
Case "Range" '数式
Set rng = obj
ErrMsg = "場所：" & rng.Address(False, False)
myArray(1, Col.種別) = Cns数式
myArray(1, Col.場所) = RangeToAddress(rng, "'")
myArray(1, Col.詳細) = rng.Formula
myArray(1, Col.判定) = isLinkExist(myArray(1, Col.詳細))
Case "Name" '名前定義
Set nm = obj
ErrMsg = "場所：" & nm.Name
myArray(1, Col.種別) = Cns名前定義
myArray(1, Col.場所) = nm.Name
myArray(1, Col.詳細) = nm.RefersTo
myArray(1, Col.判定) = isLinkExist(myArray(1, Col.詳細))
Case "FormatConditions" '条件付き書式
Set fcds = obj
Set rng = fcds.Parent.Cells
ErrMsg = "場所：" & rng.Address(False, False)
myArray(1, Col.種別) = Cns条件書式
myArray(1, Col.場所) = RangeToAddress(rng, "'")
myArray(1, Col.詳細) = fcds(i).Formula1
myArray(1, Col.判定) = isLinkExist(myArray(1, Col.詳細))
Case "Validation" '入力規則
Set vdt = obj
Set rng = vdt.Parent
ErrMsg = "場所：" & rng.Address(False, False)
myArray(1, Col.種別) = Cns入力規則
myArray(1, Col.場所) = RangeToAddress(rng, "'")
myArray(1, Col.詳細) = vdt.Formula1 & _
IIf(vdt.Formula2 = "", _
"", vbLf & vdt.Formula2)
myArray(1, Col.判定) = isLinkExist(vdt.Formula1) & _
IIf(vdt.Formula2 = "", _
"", vbLf & _
isLinkExist(vdt.Formula2, False))
Case "Shape" 'オブジェクトの登録マクロ
Set sp = obj
Set rng = sp.TopLeftCell
ErrMsg = "場所：" & rng.Address(False, False)
myArray(1, Col.種別) = Cnsマクロ登録
myArray(1, Col.場所) = sp.Name & ":" & RangeToAddress(rng)
myArray(1, Col.詳細) = sp.OnAction
myArray(1, Col.判定) = isLinkExist(myArray(1, Col.詳細))
Case Else 'あり得ないが念のため
ErrMsg = TypeName(obj) & ":" & obj.Name
End Select
errRow = .Cells(.Rows.Count, Col.種別).End(xlUp).Row + 1
'出力セルを範囲に統合
If myArray(1, Col.種別) = .Cells(errRow - 1, Col.種別) And _
myArray(1, Col.詳細) = .Cells(errRow - 1, Col.詳細) Then
Select Case myArray(1, Col.種別)
Case Cns数式, Cns条件書式, Cns入力規則
If CntHold > 0 Then
Set rng1 = AddressToRange(Wb, Mid(HoldAddress, 2))
Else
Set rng1 = AddressToRange(Wb, .Cells(errRow - 1, Col.場所))
End If
Set rng2 = AddressToRange(Wb, Mid(myArray(1, Col.場所), 2))
If rng.Worksheet Is rng2.Worksheet Then
Set rng = Union(rng1, rng2)
HoldAddress = RangeToAddress(rng, "'")
CntHold = CntHold + 1
If CntHold Mod 1000 = 0 Then
Call DispStatusBar("", _
"同一設定のセル範囲を統合中：" & _
HoldAddress)
DoEvents
End If
errRow = 0
End If
End Select
End If
'シートに出力
If errRow > 0 Then
If CntHold > 0 Then
.Cells(errRow - 1, Col.場所) = HoldAddress
HoldAddress = "": CntHold = 0
Call DispStatusBar("")
End If
.Range(.Cells(errRow, Col.種別), .Cells(errRow, Col.判定)) = myArray
'マクロブックに切り替えて進捗が見えるように
ThisWorkbook.Activate
DoEvents
If errRow > 0 Then .Cells(errRow, Col.場所).Select
DoEvents
End If
CntLink = CntLink + 1
End With
'表示最大件数の確認
If errRow - StartErrRow + 1 > CntMax Then
ErrMsg = ErrMsg & vbLf & vbLf & _
"エラー最大件数件を超えました。" & vbLf & vbLf & _
"処理を終了します。"
setError = True
Exit Function
End If
setError = False
End Function
'### 他ブックのリンク先のファイル存在確認 ###
Private Function isLinkExist(ByVal strLink As String, _
Optional ByVal ErrCntUp As Boolean = True) _
As String
Dim wbWork As Workbook
Dim i As Long
Dim iPos As Integer
Dim sTemp As String
isLinkExist = ""
If strLink = "" Then Exit Function
'他ブック参照が複数ある場合は判定保留
If strLink Like "*[[]*[]]*[[]*[]]*" Then
isLinkExist = Cns三角
CntPend = CntPend + 1
Exit Function
End If
'引数の受け取りと、先頭の=削除
sTemp = strLink
If Left(sTemp, 1) = "=" Then sTemp = Mid(sTemp, 2)
'数式先頭の関数を削除
iPos = 0
For i = 1 To Len(sTemp)
If Mid(sTemp, i, 1) = "(" Or _
Mid(sTemp, i, 1) = "'" Or _
Mid(sTemp, i, 1) = "[" Then
iPos = i
Else
If (Mid(sTemp, i, 1) >= "A" And Mid(sTemp, i, 1) <= "Z") Or _
(Mid(sTemp, i, 1) >= "0" And Mid(sTemp, i, 1) <= "9") Or _
Mid(sTemp, i, 1) = "." Or _
Mid(sTemp, i, 1) = "," Then
Else
Exit For
End If
End If
Next
If iPos > 0 Then
If Mid(sTemp, iPos, 1) = "[" Then
sTemp = Mid(sTemp, iPos)
Else
sTemp = Mid(sTemp, iPos + 1)
End If
End If
'他ブックのフルパス取得、[]と!と\で判定
If sTemp Like "*[[]*[]]*" Then
sTemp = Left(sTemp, InStrRev(sTemp, "!") - 1)
sTemp = Left(sTemp, InStrRev(sTemp, "]") - 1)
If InStr(sTemp, "\") > 0 Then
iPos = InStrRev(sTemp, "\")
Else
iPos = 1
End If
iPos = InStr(iPos, sTemp, "[")
sTemp = Left(sTemp, iPos - 1) & Mid(sTemp, iPos + 1)
If Left(sTemp, 1) = "'" Then sTemp = Mid(sTemp, 2)
Else
sTemp = Left(sTemp, InStr(sTemp, "!") - 1)
If Right(sTemp, 1) = "'" Then sTemp = Left(sTemp, Len(sTemp) - 1)
If Left(sTemp, 1) = "'" Then sTemp = Mid(sTemp, 2)
End If
'ブック名だけの場合は、開いているブックを探す
If InStr(sTemp, "\") = 0 Then
For Each wbWork In Workbooks
If wbWork.Name = sTemp Then
Exit Function
End If
Next
End If
'フルパス以外はエラー
If InStr(sTemp, "\") = 0 Then
isLinkExist = Cnsバツ
If ErrCntUp Then CntErr = CntErr + 1
Exit Function
End If
'Dir関数でファイルの存在確認
If Dir(sTemp) = "" Then
If Err Then '数式が複雑なためフルパスに変換失敗
Err.Clear
isLinkExist = Cns三角
CntPend = CntPend + 1
Exit Function
End If
isLinkExist = Cnsバツ
If ErrCntUp Then CntErr = CntErr + 1
End If
End Function
'### Rangeオブジェクトからセルのアドレス文字を作成 ###
Private Function RangeToAddress(ByVal rng As Range, _
Optional ByVal strFix As String) _
As String
RangeToAddress = strFix & "'" & rng.Worksheet.Name & _
"'!" & rng.Address(False, False)
End Function
'### セルのアドレス文字からRangeオブジェクトを作成 ###
Private Function AddressToRange(ByVal Wb As Workbook, _
ByVal sAddress As String, _
Optional ByVal i As Long = 0) _
As Range
Dim sSheet As String
Dim sRange As String
Dim iPos As Long
'アドレス文字に!がない場合は処理不能
If InStr(sAddress, "!") = 0 Then
If i > 0 Then MsgBox "B" & i & "セルの値が不正です。"
End
End If
Err.Clear '念のため呼出元でエラーが出ていた場合
'"!"でシート名とセルアドレス文字に分割
iPos = InStrRev(sAddress, "!")
sSheet = Mid(sAddress, 2, iPos - 3)
sRange = Mid(sAddress, iPos + 1)
'シート名とセルアドレス文字からRangeオブジェクト作成
Set AddressToRange = Wb.Worksheets(sSheet).Range(sRange)
If Err Then
Err.Clear
If i > 0 Then MsgBox "B" & i & "セルの値が不正です。"
End
End If
End Function
'### ステータスバー表示 ###
Private Sub DispStatusBar(ByVal argMsg1 As String, _
Optional ByVal argMsg2 As String = "")
Static StatusMsg As String '静的変数
If argMsg1 <> "" Then StatusMsg = argMsg1
If argMsg2 <> "" Then argMsg2 = "（" & argMsg2 & "）"
Application.StatusBar = StatusMsg & argMsg2
DoEvents
End Sub
'### セル数が多いと「反応なし」になることへの対応 ###
Private Sub EventForEachCount()
CntAll = CntAll + 1
If CntAll Mod 10000 = 0 Then DoEvents
End Sub
'### E列で削除指定の実行処理 ###
Public Sub DeleteErrorLink()
Dim cntDo As Long
Dim cntFail As Long
Dim sTemp As String
Dim rng As Range
Dim i As Long
Set WsErr = ActiveSheet 'リンクエラー検索
On Error Resume Next
'対象ブックの取得と、「検索実行」時との確認
sTemp = WsErr.Range(NmTargetBook).Value
sTemp = Mid(sTemp, InStrRev(sTemp, "\") + 1)
Set Wb = Workbooks(sTemp)
If Err Then
MsgBox "対象ブックが開かれていません。" & vbLf & vbLf & _
"「検索開始」実行後に行ってください。"
Exit Sub
End If
If WsErr.Range(NmTargetBook).Value <> Wb.FullName Then
MsgBox "対象ブックの保存パスが変更されています。" & vbLf & vbLf & _
"「検索開始」実行後に行ってください。"
Exit Sub
End If
'実行可否の確認
If MsgBox("「削除」で「する」が選択されている、他ブックへのリンクを削除します。" & vbLf & vbLf & _
"元に戻すことはできません。" & vbLf & vbLf & _
"万一の場合は、実行後に「保存しない」で対応してください。" & vbLf & vbLf & _
"実行してよろしいですか。", vbYesNo, "確認") = vbNo Then
Exit Sub
End If
'削除処理
CntDel = 0: cntDo = 0: cntFail = 0
With WsErr
cntDo = WorksheetFunction.CountIf(.Columns(Col.削除), Cnsする)
For i = StartErrRow To .Cells(.Rows.Count, Col.種別).End(xlUp).Row
If .Cells(i, Col.削除) = Cnsする Then
sTemp = .Cells(i, Col.場所)
Select Case .Cells(i, Col.種別)
Case Cns数式 '数式
Set rng = AddressToRange(Wb, sTemp, i)
rng.ClearContents
If Err Then
Err.Clear
cntFail = cntFail + 1
Else
.Cells(i, Col.削除) = Cns削除済
CntDel = CntDel + 1
End If
Case Cns名前定義 '名前定義
Wb.Names(sTemp).Delete
If Err Then
Err.Clear
cntFail = cntFail + 1
Else
.Cells(i, Col.削除) = Cns削除済
CntDel = CntDel + 1
End If
Case Cns条件書式 '条件付き書式
Set rng = AddressToRange(Wb, sTemp, i)
rng.FormatConditions.Delete
If Err Then
Err.Clear
cntFail = cntFail + 1
Else
.Cells(i, Col.削除) = Cns削除済
CntDel = CntDel + 1
End If
Case Cns入力規則 '入力規則
Set rng = AddressToRange(Wb, sTemp, i)
rng.Validation.Delete
If Err Then
Err.Clear
cntFail = cntFail + 1
Else
.Cells(i, Col.削除) = Cns削除済
CntDel = CntDel + 1
End If
Case Cnsマクロ登録 'オブジェクトの登録マクロ
sTemp = Mid(sTemp, InStr(sTemp, ":") + 1)
Set rng = AddressToRange(Wb, sTemp, i)
sTemp = .Cells(i, Col.場所)
sTemp = Left(sTemp, InStr(sTemp, ":") - 1)
rng.Worksheet.Shapes(sTemp).OnAction = ""
If Err Then
Err.Clear
cntFail = cntFail + 1
Else
.Cells(i, Col.削除) = Cns削除済
CntDel = CntDel + 1
End If
End Select
End If
Next
End With
''終了メッセージ
MsgBox "削除完了しました。" & vbLf & vbLf & _
"削除する数=" & Format(cntDo, "#,##0") & vbLf & _
"削除成功数=" & Format(CntDel, "#,##0") & vbLf & _
"削除失敗数=" & Format(cntFail, "#,##0"), _
vbOKOnly, "結果表示"
End Sub
同じテーマ「マクロVBAサンプル集」の記事
数独（ナンプレ）を解くアルゴリズムの要点とパフォーマンスの検証№1
ナンバーリンク(パズル)を解くVBAに挑戦№1
ナンバーリンクを解くVBAのパフォーマンス改善№1
オセロを作りながらマクロVBAを学ぼう
他ブックへのリンクエラーを探し解除
Excelシートの複雑な計算式を解析するVBA
Excel将棋：マクロVBAの学習用(№1)
Excel囲碁：万波奈穂先生に捧ぐ
Excel囲碁：再起動後も続けて打てるように改造
エクセルVBAで15パズルを作ってみた
エクセル麻雀ミニゲーム
新着記事NEW ・・・新着記事一覧を見る
ブール型（Boolean）のis変数・フラグについて｜VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する｜VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次｜エクセルの神髄(2024-03-20)
VBA10大躓きポイント（初心者が躓きやすいポイント）｜VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成｜ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。｜エクセル雑感(2024-02-17)
初級脱出10問パック｜VBA練習問題(2024-01-24)
累計を求める数式あれこれ｜エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE｜エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。｜エクセル雑感(2023-12-28)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜VBA入門
4.ひらがな⇔カタカナの変換｜エクセル基本操作
5.繰り返し処理（For Next)｜VBA入門
6.変数宣言のDimとデータ型｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.Findメソッド（Find,FindNext,FindPrevious）｜VBA入門
- ホーム
- マクロVBA応用編
- マクロVBAサンプル集
- 他ブックへのリンクエラーを探し解除するマクロ（変更前）
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。