ユーザー定義関数

ファイルが使用中か調べる関数

◆関数名:fncWriteCheck
指定したファイルが書込み可能な状態で開けるかチェックします。
書き込み状態で開ける場合、Trueの場合ファイルは開きっぱなしにします。

ファイルが開いているか確認する関数fncXlsOpenと併用します。


◆引数:
strBookPath(String型)・・・チェックするブックのパス
strBookName(String型)・・・チェックするブック名


◆戻り値:
ファイルが未使用中ならTrue、ファイルが使用中ならFlase


コード



Public Function fncWriteCheck(strBookPath As String, strBookName As String) As Boolean

fncWriteCheck = True

'◆ファイルを読み取り専用で開いている場合はいったん閉じる
If fncXlsOpen(strBookName) = True Then
  If Workbooks(strBookName).ReadOnly = True Then
    Workbooks(strBookName).Close
  End If
End If

'◆開いていない場合、書き込みできる状態で開けるか試す
If fncXlsOpen(strBookName) = False Then
  Workbooks.Open strBookPath & strBookName

  '◆他の人が使用中の場合ファイルを閉じる
  If Workbooks(strBookName).ReadOnly = True Then
    fncWriteCheck = False
    Workbooks(strBookName).Close
  End If
End If

End Function


コード解説


他の人がブックを開いている時にマクロでブックを開くと読み取り専用で開かれます。
読み取り専用のブックをマクロで保存する場合、Saveメソッドの場合は
名前をつけて保存のダイアログがでますが、
CloseメソッドのSavechangesにTrueを指定して保存する場合は
エラーメッセージも何も表示されず、しかも保存がされていない状態になります。

それを未然に書き込む前にファイルが使用中か調べるユーザー定義関数です。
開いた後、読み取り専用になっているかどうかで使用中かどうかをチェックします。

使用例



Sub ファイルが使用中か調べる()

Dim strFilePath As String
Dim strFileName As String

strFilePath = ThisWorkbook.Path & "\"
strFileName = "Book1.xls"

If fncWriteCheck(strFilePath, strFileName) = False Then
  MsgBox "ファイルが使用中です。" & vbCrLf & "時間をおいて再度実行してください。"
  Exit Sub
End If

End Sub


※注意点
同じブックにファイルが開いているか確認する関数fncXlsOpenも
追加してから実行してください。

ユーザー定義関数

ファイルが開いているか確認する関数

◆関数名:fncXlsOpen
ブックが開いているかチェックします。

◆引数:
strBookName(String型)・・・チェックするブック名

◆戻り値:
ブックが開いていればTrue、開いていなければFalse

コード



Public Function fncXlsOpen(strBookName As String) As Boolean

Dim objWB As Workbook

fncXlsOpen = False

For Each objWB In Workbooks
  If objWB.Name = strBookName Then
    fncXlsOpen = True
  End If
Next objWB

End Function


コード解説


基本はシートが存在するか確認する関数fncSheetCheckと同じです。
For Each...Nextステートメントでワークブックに対してループしています。

使用例



Sub ブックが開いているか確認する()

Dim strFileName As String

strFileName = "Book1.xls"

'◆ブックが開いているか確認して、開いていなかったら開く
If fncXlsOpen(strFileName) = False Then
  Workbooks.Open ThisWorkbook.Path & "\" & strFileName
Else
  MsgBox strFileName & "はすでに開いています。"
End If

End Sub


ユーザー定義関数

シートが存在するか確認する関数

◆関数名:fncSheetCheck
ブックにシートがあるかチェックします。

◆引数:
strBookName(String型)・・・チェックするブック名
strSheetName(String型)・・・チェックするシート名

◆戻り値:
シートがあればTrue、なければFalse

コード



Public Function fncSheetCheck(strBookName As String, strSheetName As String) As Boolean

Dim objWS As Worksheet

fncSheetCheck = False

For Each objWS In Workbooks(strBookName).Sheets
  If objWS.Name = strSheetName Then
    fncSheetCheck = True
  End If
Next objWS

End Function


コード解説


For Each...Nextステートメントを使って、
指定したブック内のすべてのワークシートに対してループしています。

ループ中のシートはWorkSheet型で宣言した変数objWSに参照がセットされます。
現在ループ中のシート名と引数で指定したシート名が一致したらTrueを返しています。

使用例



Sub シートがあるか確認()

Dim result As Boolean
Dim strSheetName As String

strSheetName = "Sheet1"
result = fncSheetCheck(ThisWorkbook.Name, strSheetName)

If result = True Then
  MsgBox strSheetName & "は存在します。"
Else
  MsgBox strSheetName & "は存在しません。"
End If

End Sub




ユーザー定義関数

最終行を取得する関数

◆関数名:fncGetLastRow
指定した範囲の最終行を取得します。

◆引数:
TargetArea(Range型)・・・最終行を探す範囲

Mode(Long型、省略可能)
1・・・値だけを検索対象とします。
2・・・数式も検索に含めます。
(数式で""を表示させているような場合も値があるとみなします)
引数を省略した場合は、Mode1で最終行を取得します。

◆戻り値:
TargetAreaで指定した範囲の最終行

サンプルコード



Public Function fncGetLastRow(TargetArea As Range, Optional Mode As Long = 1) As Long

Dim SearchMode As Long
Dim ResultCell As Range

SearchMode = xlValues
If Mode = 2 Then
  SearchMode = xlFormulas
End If

'◆可視範囲での最終行取得
Set ResultCell = TargetArea.Find( _
        What:="*", After:=TargetArea.Cells(1, 1), _
        LookIn:=SearchMode, LookAt:=xlPart, _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
        MatchCase:=False, MatchByte:=False)

'◆検索範囲がすべて空白だった場合は1行目を返す
If ResultCell Is Nothing Then
  fncGetLastRow = TargetArea.Cells(1, 1).Row
  Exit Function
End If

'◆最終行以降に非表示の行がないかチェック
Do Until ResultCell.Offset(1, 0).Value = ""
  Set ResultCell = ResultCell.Offset(1, 0)
Loop

fncGetLastRow = ResultCell.Row

Set ResultCell = Nothing

End Function


解説


Findメソッドを使って、検索範囲の下のセルから上方向に向かって
値の入っているセルを探します。

Findメソッドでは非表示の行は検索対象外になってしまうので、
1度検索結果を取得したあとに下のセルに値が入っていないか
再度チェックしています。

使用例



Sub 最終行の取得()

Dim lngRow As Long

With ThisWorkbook.Worksheets(1)

  lngRow = fncGetLastRow(.Range("A:D"), 1)

End With

MsgBox lngRow

End Sub


上記コードはマクロがあるブックの一番左のシートの
A〜D列の最終行を取得します。

下記のような表の場合、引数modeに1を指定、もしくは省略すると
最終行は「9」と表示されます。

modeを2に指定(数式を検索に含める)と最終行は「10」と
表示されます。

最終行が非表示の場合でも、値or数式があれば最終行として
カウントします。

※注意点
可視範囲の最終行以降に非表示の行がたくさんあると
処理に時間がかかります。


Powered by Seesaa
×

この広告は1年以上新しい記事の投稿がないブログに表示されております。