'=========================================================================================
' 497 単位選択入力
'-----------------------------------------------------------------------------------------
'【ヒント】
' タイトル機能に関係するコードは、「Module2」シートにあります。


'=========================================================================================
' ◆標準モジュールのコード◆
'-----------------------------------------------------------------------------------------
Sub おためしマクロ()
    作業選択シートを表示する
End Sub
'-----------------------------------------------------------------------------------------



'=========================================================================================
'   ★ 単位選択入力 V1.1 ★                           Copyright(c)1998-2000 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シートを隠す()
    Exit Sub                                    'この機能は止めてあります
    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
'=========================================================================================
'  V1.1  2000.5.8　　　　　　　　　　　　　　　　　　　　　　ExcelVBAマクロ 500連発 第2弾
'=========================================================================================