Common

Public cn As ADODB.connection
Public rs As ADODB.Recordset
Public cmd As ADODB.Command
Public Const rel_ID2007 = "http://schemas.microsoft.com/office/2006/relationships/ui/extensibility"
Public Const rel_ID2010 = "http://schemas.microsoft.com/office/2007/relationships/ui/extensibility"
Public Const customUI_ID2007 = "http://schemas.microsoft.com/office/2006/01/customui"
Public Const customUI_ID2010 = "http://schemas.microsoft.com/office/2009/07/customui"
Public Const Ver2007 = "Ver2007"
Public Const Ver2010 = "Ver2010"
Public Const Type_rel = "rel"
Public Const Type_customUI = "customUI"
Private Const adOpenDynamic       As Long = 2
Private Const adLockOptimistic    As Long = 3
Public Sub Dev00BtnRibbonSet_onAction()
    RibbonCommonZip.rbIRibbonUI.Invalidate
End Sub

Public Sub SqlExecute(ByVal strSql As String)
    cnOpen (ExcelConnect)
    Set cmd = New ADODB.Command
    With cmd
        .CommandText = strSql
        .ActiveConnection = cn
        .Execute
    End With
   
    cnClose
End Sub
Public Function strKetaSoroe(ByVal 元データ As String, ByVal 桁数 As Integer) As String
     Dim iLength As Integer
     iLength = Len(元データ)
     If 桁数 < iLength Then
         strKetaSoroe = "Error"
     Else
         strKetaSoroe = 元データ & String(桁数 - iLength, " ")
     End If
 End Function
Public Function GetRecordSet(strSql As String, objCN As Object) As ADODB.Recordset

  Dim objRS             As ADODB.Recordset
 
 
  Set objRS = New ADODB.Recordset
 
 
  objRS.Open strSql, objCN, adOpenDynamic, adLockOptimistic
 
 
  Set GetRecordSet = objRS
 
 
End Function
Public Function ExcelConnect() As String
    ExcelConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                        & "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" _
                        & "Extended Properties=""Excel 8.0;" _
                        & "HDR=Yes"";"

End Function

Public Sub cnOpen(ByVal connectString As String)
    Set cn = New ADODB.connection
    cn.ConnectionString = connectString
    cn.Open
   
End Sub

Public Sub cnClose()
    If (rs Is Nothing) = False Then
   
    If rs.State <> adStateClosed Then
   
        rs.Close
   
    End If
   
    End If
    Set rs = Nothing
   
    If cn.State <> adStateClosed Then
   
        cn.Close
   
    End If
   
   
    Set cn = Nothing
 

End Sub
Public Function xmlVerChk(ByVal Data As String, ByVal XML_FileType As String) As String
    Dim ChkData As String
    Select Case XML_FileType
    Case Type_rel
        ChkData = rel_ID2007
    Case Type_customUI
        ChkData = customUI_ID2007
    End Select
   
   
    If InStr(Data, ChkData) > 0 Then
        xmlVerChk = Ver2007
    Else
        xmlVerChk = Ver2010
    End If
   
End Function

Public Function xmlChgVer(ByVal Data As String, ByVal XMLType As String, ByVal Ver As String) As String
    Dim ChkData As String
    Dim DataVer As String
    Dim ChgAfterData As String
    Dim ChgBeforeData As String
   
    DataVer = xmlVerChk(Data, XMLType)
    If DataVer = Ver Then
        xmlChgVer = Data
    Else
        Select Case XMLType
            Case Type_rel
                If Ver = Ver2007 Then
                    ChgBeforeData = rel_ID2010
                    ChgAfterData = rel_ID2007
                Else
                    ChgBeforeData = rel_ID2007
                    ChgAfterData = rel_ID2010
                End If
            Case Type_customUI
                If Ver = Ver2007 Then
                    ChgBeforeData = customUI_ID2010
                    ChgAfterData = customUI_ID2007
                Else
                    ChgBeforeData = customUI_ID2007
                    ChgAfterData = customUI_ID2010
                End If
        End Select
        xmlChgVer = Replace(Data, ChgBeforeData, ChgAfterData)
    End If
   
End Function