'=========================================================================================
'
' すぐに役立つエクセルVBAマクロ集    単位選択入力     ★ Copyright(c)1998 Yoshioh Nagai ★
'
'=========================================================================================
Option Explicit
Dim タイトル As String                          'メッセージボックスのタイトル
Dim メッセージ As String                        'メッセージボックスのメッセージ
Dim スタイル As Variant                         'メッセージボックスのスタイル
Dim yesno As Variant                            'メッセージボックスの返答
Dim 上 As Integer                               'シートの上端セルの行番号
Dim 左 As Integer                               'シートの左端セルの列番号
Dim 下 As Integer                               'シートの下端セルの行番号
Dim 右 As Integer                               'シートの右端セルの列番号
'=========================================================================================
Sub auto_open()                           'ブックが開かれたときに自動的に実行されるマクロ
    ユーザーが再表示できないようにDBシートを隠す
    Sheets("入出力").Select                     '画面に表示するシートを選ぶ
    入出力シートをクリアする
    Application.ScreenUpdating = False          '画面を更新しない
    タイトル = "選択"
    メッセージ = "インチ表示しますか？" & Chr(13) & "（[いいえ] … メートル表示）"
    スタイル = vbYesNo + vbQuestion + vbDefaultButton1 + vbApplicationModal
    yesno = MsgBox(メッセージ, スタイル, タイトル)
    隠したDBシートをもどす
    If yesno = vbYes Then
        Sheets("入出力").Range("D1") = "インチ法"
        Sheets("MtoI").Select                   'シートを選択する
        シートの下端と右端を調べて範囲選択する
    Else
        Sheets("入出力").Range("D1") = "メートル法"
        Sheets("DB").Select
        シートの下端と右端を調べて範囲選択する
    End If
    入出力シートに複写する
    ユーザーが再表示できないようにDBシートを隠す
End Sub
'-----------------------------------------------------------------------------------------
Private Sub ユーザーが再表示できないようにDBシートを隠す()
    Sheets("DB").Visible = xlVeryHidden
End Sub
'-----------------------------------------------------------------------------------------
Private Sub 入出力シートをクリアする()
    Sheets("入出力").Select                     'シートを選択する
    上 = 2                                      '基点セルの行番号(A2セルの2)
    左 = 1                                      '基点セルの列番号(A2セルのAの数字表記)
    下 = Range(Cells(上, 左), Cells(上, 左)).End(xlDown).Row       '下端検出
    右 = Range(Cells(上, 左), Cells(上, 左)).End(xlToRight).Column '右端検出
    Range(Cells(上, 左), Cells(下, 右)).ClearContents '検出した範囲の数式と値をクリアする
    Range("D1") = ""                            'メートル法インチ法を表示するセルをクリア
    Range("A1").Select
End Sub
'-----------------------------------------------------------------------------------------
Private Sub シートの下端と右端を調べて範囲選択する()
    上 = 2
    左 = 1
    下 = Range(Cells(上, 左), Cells(上, 左)).End(xlDown).Row
    右 = Range(Cells(上, 左), Cells(上, 左)).End(xlToRight).Column
    Range(Cells(上, 左), Cells(下, 右)).Select  '検出した範囲を選択
End Sub
'-----------------------------------------------------------------------------------------
Private Sub 入出力シートに複写する()
        Selection.Copy                          'どちらかのシートからコピー
    Sheets("入出力").Select
        Range("A2").PasteSpecial Paste:=xlFormats '書式を貼り付け
        Range("A2").PasteSpecial Paste:=xlValues '値を貼り付け
        Range("A1").Select
End Sub
'=========================================================================================
Sub auto_close()                        'ブックが閉じられたときに自動的に実行されるマクロ
    Application.ScreenUpdating = False          '画面を更新しない
    タイトル = "確認"
    メッセージ = "作業結果をデータベースに反映しますか"
    スタイル = vbYesNo + vbQuestion + vbDefaultButton1 + vbApplicationModal
    yesno = MsgBox(メッセージ, スタイル, タイトル)
    If yesno = vbYes Then
        If Sheets("入出力").Range("D1") = "インチ法" Then
            Sheets("ItoM").Select               'インチをメートルに換算したシート
        Else
            Sheets("入出力").Select             'メートル法で入力されているシート
        End If
        シートの下端と右端を調べて範囲選択する
        DBシートに複写する
        Sheets("入出力").Select                 '次に開いたときに画面をちらつかせないため
        ActiveWorkbook.Save                     '上書き保存する
    Else
        Application.DisplayAlerts = False       '閉じる際に確認メッセージを出さない
        ActiveWorkbook.Close                    'ブックを閉じる
    End If
End Sub
'-----------------------------------------------------------------------------------------
Private Sub DBシートに複写する()
        Selection.Copy                          'どちらかのシートからコピー
    隠したDBシートをもどす
    Sheets("DB").Select
        Range("A2").PasteSpecial Paste:=xlValues '値を貼り付け
        Range("A1").Select
End Sub
'-----------------------------------------------------------------------------------------
Sub 隠したDBシートをもどす()                'Subとしたのはハンド操作でマクロの実行が可能に
    Sheets("DB").Visible = True
End Sub
'=========================================================================================
'  サンプルマクロ  単位選択入力   http://plaza18.mbn.or.jp/~Happy/   (C)1998.9.19   V1.0
'=========================================================================================