マイナンバーのチェックデジットをVBAで算出

個人用マイナンバーのチェックデジットをVBAで算出してみました。

参考までに。。。

' http://law.e-gov.go.jp/announce/H26F11001000085.html
'
' (検査用数字を算出する算式)
' 第五条 令第八条の総務省令で定める算式は、次に掲げる算式とする。
' 算式
'  11―(n=1(シグマ)11(Pn×Qn))を11で除した余り)
'  ただし、(n=1(シグマ)11(Pn×Qn))を11で除した余り≦1の場合は、0とする。
' 算式の符号
'   Pn 個人番号を構成する検査用数字以外の十一桁の番号の最下位の桁を1桁目としたときのn桁目の数字
'  Qn 1≦n≦6のとき n+1 7≦n≦11のとき n―5
'
Function CalcCheckDigit(number As String) As Integer
    Dim digits As String
    Dim chkDigit As String
    Dim cd As Integer
    
    cd = -1

    ' 12桁でなければ無効
    If Len(number) <> 12 Then
        CalcCheckDigit = cd
        Exit Function
    End If
    
    ' チェックデジット部分を取出し
    chkDigit = Right(number, 1)
    
    ' マイナンバー11桁取出し
    digits = Left(number, 11)
    
    Dim n, pn, qn, m As Long
    Dim sum As Long
    
    res = False
    sum = 0
    
    For n = 1 To 11
        ' n桁目の数字
        ' 小さい桁から計算(検査用数字以外の十一桁の番号の最下位の桁を1桁目)
        pn = CInt(Mid(digits, 11 - n + 1, 1))
        
        ' 1≦n≦6のときn+1
        If n <= 6 Then
            qn = n + 1
        ' 7≦n≦11のときn―5
        Else
            qn = n - 5
        End If
        
        sum = sum + pn * qn
    Next
    
    ' 11 で割った余り
    m = sum Mod 11

    ' (n=1(シグマ)11(Pn×Qn))を11で除した余り≦1の場合は、0とする
    If m <= 1 Then
        cd = 0
    ' 11―(n=1(シグマ)11(Pn×Qn))を11で除した余り)
    Else
        cd = 11 - m
    End If

    CalcCheckDigit = cd
End Function

ためしに自分のマイナンバーで計算してみると合っていました。^_^;

参考サイト:
http://qiita.com/qube81/items/fa6ef94d3c8615b0ce64

Access フォームのウィンドウサイズ調整

Access のフォームを開いたときに、最大化ではなくてAccess のクライアント領域のサイズで開きたいのですが、意外に難しかったです。あるフォームの Form_Open イベントで FormAutoResizing を呼ぶとクライアント領域のサイズに合わせて表示できます。

Private Sub Form_Open(Cancel As Integer)
    ' ウィンドウの大きさ自動調整
    FormAutoResizing
End Sub
' ウィンドウサイズ調整
Public ResWidth As String
Public ResHeight As String

Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, rectangle As RECT) As Long
Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Type RECT
   x1 As Long
   y1 As Long
   x2 As Long
   y2 As Long
End Type

'
' https://support.microsoft.com/en-us/kb/94927?wa=wsignin1.0
'
Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Const HWND_DESKTOP As Long = 0
Const LOGPIXELSX As Long = 88
Const LOGPIXELSY As Long = 90

'--------------------------------------------------
Function PixelXToTwips(pixelsx As Long) As Single
    Dim lngDC As Long
    lngDC = GetDC(HWND_DESKTOP)
    PixelXToTwips = pixelsx * 1440& / GetDeviceCaps(lngDC, LOGPIXELSX)
    ReleaseDC HWND_DESKTOP, lngDC
End Function

'--------------------------------------------------
Function PixelYToTwips(pixelsy As Long) As Single
    Dim lngDC As Long
    lngDC = GetDC(HWND_DESKTOP)
    PixelYToTwips = pixelsy * 1440& / GetDeviceCaps(lngDC, LOGPIXELSY)
    ReleaseDC HWND_DESKTOP, lngDC
End Function
            


Public Function FormAutoResizing()
    Dim ret As Long
    Dim rc As RECT
    Dim w As Integer
    Dim h As Integer
    
    Dim hWnd As Long
    ' Access のクライアント領域を検索
    hWnd = FindWindowEx(Application.hWndAccessApp, 0, "MDIClient", vbNullString)
    If hWnd = 0 Then
        hWnd = Application.hWndAccessApp
    End If
    
    ret = GetClientRect(hWnd, rc)

    If ret Then
        w = PixelXToTwips(rc.x2 - rc.x1)
        h = PixelYToTwips(rc.y2 - rc.y1)
        DoCmd.MoveSize 0, 0, w, h
    End If
End Function