www.pudn.com > Doe.rar > mdlVarChar.bas

Attribute VB_Name = "mdlVarChar" 
Option Explicit 
Public iFirst As Boolean 
Public isGetCN As Boolean 
Public cnData As New Connection 
Public cnExcel As Connection                        '資料庫連結引擎 ( Excel 匯出用 ) 
Public strSQL As String 
Public i As Long, j As Long, k As Long 
Public connStr As String 
Public cSearch As String 
Public strTemp As String 
Public rsFactor As Recordset 
Public aryStdData() As Single               '紀錄平均值 
Public rsStdData As ADODB.Recordset         '產生 VARIANCE 的 RS 
Public rsAnoData As ADODB.Recordset         '產生 ANOVA 的 RS 
Public isExcelOpen As Boolean               '作為 Excel 匯出連線是否開啟的判斷 
'Public FacLevel(2) As String               '紀錄控制因子的水準資料 (),控制因子最多有 3 個水準,所以陣列固定為 2 
'Public gnWhatVersion As Integer             '作為key的判斷值 
'Public gnSpecialCust As Integer             '作為key的判斷值 
'Public goKeyCheck As Object 
 
 
Public Sub GetCN() 
    If isGetCN = False Then 
        Set cnData = New Connection 
        Set cnData = Nothing 
        If cnData.State <> adStateClosed Then cnData.Close 
'        'Local or NetWork 
'        If nDB = "LOCAL" Then           'Local 
            connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & _ 
                      "\DOE.msp;Persist Security Info=False" 
            cnData.ConnectionString = connStr 
            cnData.Open 
'            GetCN = True 
            Exit Sub 
'        ElseIf nDB = "NETWORK" Then     'NetWork 
'            cmdbPath = GetSetting("CANNO", "DATABASE", "NETPATH", "") 
'            If cmdbPath = "" Then 
'                MsgBox "資料庫設定錯誤", vbOKOnly + vbCritical 
'                Exit Function 
'            Else 
'                connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & cmdbPath & _ 
'                        "\Canno.msp;Persist Security Info=False" 
'                cnData.ConnectionString = connStr 
'                cnData.Open 
'                GetCN = True 
'                Exit Function 
'            End If 
'        End If 
    End If 
     
End Sub 
 
 
Public Function CreatRS(ByVal cSQLStr As String) As ADODB.Recordset 
    Dim cRS As Recordset 
    Set cRS = New Recordset 
    With cRS 
        .CursorLocation = adUseClient   '設定游標端 
        .CursorType = adOpenDynamic 
        If .State <> adStateClosed Then .Close 
        cnData.CursorLocation = adUseClient 
        .Open cSQLStr, cnData, adOpenDynamic, adLockOptimistic 
        Set .ActiveConnection = Nothing 
        Set CreatRS = .Clone 
        .Close 
    End With 
     
    Set cRS = Nothing 
     
End Function 
 
 
'得到各檔案的 ID 
Public Function GetAutoNumber(ByVal mField As String) As Long 
    'dim vachart 
    Dim cID As Long 
    Dim GetAgain As Boolean 
    Dim rsAutoNumber As New Recordset 
     
    On Error GoTo RR 
    rsAutoNumber.Open "IDRecord", cnData, adOpenDynamic, adLockOptimistic 
         
        '判別資料庫內是否有資料 
        With rsAutoNumber 
            If .RecordCount <= 0 Then 
                .AddNew 
                .Fields(mField).Value = 1 
                .Update 
            End If 
        End With 
         
        '取得自動編號 
        GetAgain = True 
        Do While GetAgain 
            rsAutoNumber.Requery 
            rsAutoNumber.MoveFirst 
            cID = rsAutoNumber.Fields(mField) 
            rsAutoNumber.Fields(mField) = cID + 1 
            GetAgain = False 
            rsAutoNumber.Update 
        Loop 
         
        GetAutoNumber = cID 
         
        rsAutoNumber.Close 
        Set rsAutoNumber = Nothing 
     
Exit Function 
 
RR: 
    If Err.Number = -2147217864 Then 
        GetAgain = True 
        rsAutoNumber.CancelUpdate 
        Resume Next 
    ElseIf Err.Number = 94 Then 
        rsAutoNumber.Fields(mField) = 1 
        Resume Next 
    ElseIf Err.Number = 3705 Then 
        Resume Next 
    Else 
        MsgBox "GetAutoNumber" + Chr(13) + Err.Description + Chr(13) + CStr(Err.Number) 
        Resume Next 
    End If 
End Function 
 
 
' 傳回格式化文字 
Public Function cLaiFormat(ByVal nValue As Double, ByVal nPoint As Integer) As String 
    Dim nInt As Integer, cFormat As String, i As Integer 
    Dim cPoint As String 
    cPoint = "" 
    If nPoint > 0 Then 
        For i = 1 To nPoint 
            cPoint = cPoint & "0" 
        Next 
        cPoint = "######0." & cPoint 
    Else 
        cPoint = "######0" 
    End If 
    cLaiFormat = Format(nValue, cPoint) 
End Function 
 
 
Public Sub ExcelCN()                '建立 Excel 連線 
            Set cnExcel = Nothing 
            Set cnExcel = New Connection 
            If cnExcel.State <> adStateClosed Then cnExcel.Close 
            connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & _ 
                      "\dExcelModule.dll;Persist Security Info=False" 
            cnExcel.ConnectionString = connStr 
            cnExcel.Open 
            isExcelOpen = True 
            Exit Sub 
End Sub