access funLeftB関数

他のVBAコードで使用しているにも関わらず、funLeftB関数が記載もれしていたので追記します。

標準モジュール「common_utility」等を追加して
下記コードをコピー貼り付けして使用可能です。

Rem -----------------------------------------------------------
Rem     関数名   : funLeftB
Rem     処理内容 : 文字列分離関数
Rem          : 使用方法は、VBのLeft関数と同様
Rem     引  数  : P1,P2
Rem     戻り値  : 無し
Rem -----------------------------------------------------------
Function funLeftB(P1 As String, P2 As Integer) As String
    Dim str As String
    
    If IsNull(P1) Then Exit Function
    If P1 = "" Then Exit Function
    
    str = StrConv(P1, vbFromUnicode)
    funLeftB = StrConv(LeftB(str, P2), vbUnicode)
        
End Function

Rem -----------------------------------------------------------
Rem     関数名   : funMidB
Rem     処理内容 : 文字列分離関数
Rem          : 使用方法は、VBのMid関数と同様
Rem     引  数  : P1,P2,P3
Rem     戻り値  : 無し
Rem -----------------------------------------------------------
Function funMidB(P1 As String, P2 As Integer, P3 As Integer) As String
    Dim str As String
    
    If IsNull(P1) Then Exit Function
    If P1 = "" Then Exit Function
    
    str = StrConv(P1, vbFromUnicode)
    funMidB = StrConv(MidB(str, P2, P3), vbUnicode)

End Function

Rem -----------------------------------------------------------
Rem     関数名   : funLenB
Rem     処理内容 : 文字列分離関数
Rem          : 使用方法は、VBのLen関数と同様
Rem     引  数  : P1
Rem     戻り値  : 無し
Rem -----------------------------------------------------------
Function funLenB(P1 As String) As Long
    Dim str As String
    
    If IsNull(P1) Then Exit Function
    If P1 = "" Then Exit Function
    
    str = StrConv(P1, vbFromUnicode)
    funLenB = LenB(str)

End Function

Rem -----------------------------------------------------------
Rem     関数名   : funSetEditCode
Rem     処理内容 : コードを0埋め編集して返却します
Rem     引  数  : code   = 編集前のコード
Rem                lenCnt = 桁数
Rem     戻り値  : 編集結果
Rem -----------------------------------------------------------
Public Function funSetEditCode(code As String, lenCnt As Integer) As String
On Error GoTo Error
        
    If Nz(code) = "" Then
        funSetEditCode = ""
        Exit Function
    End If
    
    funSetEditCode = Format(code, String(lenCnt, "0"))

Exit Function
Error:
    MsgBox "エラーが発生しました。エラー内容:" & ERR.Description & Chr$(10), vbCritical, "0埋め編集"
End Function

コメント

タイトルとURLをコピーしました