vba



Public CheckFileName As String
Public GBKobj
Public Const CopyFileSheetName = "Sheet1"
Public Const CheckFileSheetName = "チェックツール"
Public Const StartRow = 1
Public Const RedColor = 3
Public Filename As String
Sub シート取込_Click()
    Call シート取込
End Sub
Sub シート取込()
    CheckFileName = ThisWorkbook.Name
    'Sheet1の名前!="チェックツール"の場合
    If Workbooks(CheckFileName).Sheets(1).Name <> CheckFileSheetName Then
        Application.DisplayAlerts = False
        '削除Sheet1
        Workbooks(CheckFileName).Sheets(1).Delete
    End If
   
    Dim OpenFileName As String
    Application.ScreenUpdating = False
    OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls")
    pos = InStrRev(OpenFileName, "\")
    'ファイル名
    Filename = Mid(OpenFileName, pos + 1)
   
    If OpenFileName <> "False" Then
        '読み取りファイル
        Set li = Workbooks.Open(OpenFileName, ReadOnly:=True, UpdateLinks:=0) ', Password:="tan")

        Call Gmn_Input2Refer(GBKobj)
       
        Application.ScreenUpdating = True
        Exit Sub
    Else
        Debug.Print "(false)OpenFileName = " & OpenFileName
        Exit Sub
    End If
       
End Sub
Function Gmn_Input2Refer(Gobj)
   
    Call 画面コピー
   
End Function

Sub 画面コピー()
    'Sheet1コピー
    GBKobj.Sheets(1).Copy Before:=Workbooks(CheckFileName).Sheets(CheckFileSheetName)
    'Sheet1重命名
    Workbooks(CheckFileName).Sheets(1).Name = Filename
   
End Sub