?? 復件 frm_kaoqihesuan.frm
字號:
' 'strSQL3 = "update j_fac set ifx=true where fac_id=" & Val(Left(list1(1).List(i), InStr(list1(1).List(i), ",") - 1))
' strSQL3 = "update gongxu set flg=false where htcode='" & DataCombo1.Text & "' and htcode_pro='" & Left(List1(1).List(i), InStr(List1(1).List(i), ",") - 1) & "'"
' mDB.ExecuteSQL strSQL3
'' List1.RemoveItem List1.List(i)
judgeList List2, List1.List(i)
stmp = stmp & "'" & List1.List(i) & "',"
'List12.AddItem List1.List(i)
'List2.Selected(List2.ListCount - 1) = True
End If
Next i
stmp = Left(stmp, Len(stmp) - 1)
' 'For i = 0 To List1.ListCount - 1 ''' To 0 Step -1
' For i = List1.ListCount - 1 To 0 Step -1
' If List1.Selected(i) = True Then
' 'If InStr(sTmp, List1.List(i)) Then
' ''Debug.Print Val(Left(list1(0).List(I), InStr(list1(0).List(I), ",") - 1))
' 'strSQL3 = "update j_fac set ifx=false where fac_id=" & Val(Left(List1(0).List(i), InStr(List1(0).List(i), ",") - 1))
' 'mDB.ExecuteSQL strSQL3
' ''List1(1).AddItem List1(0).List(i)
'
' 'List1.Selected(i) = False
'
' 'List1.RemoveItem List1.List(i)
' List1.RemoveItem List1.ListIndex
'
'
' End If
' Next i
List1.Clear
For i = 0 To nCount
If InStr(stmp, "'" & sList(i) & "'") Then
Else
List1.AddItem sList(i)
End If
Next i
' DataCombo1_Click 2
'Reload_PrimaryRS 1
End Sub
Private Sub cmdright_Click()
' Dim i As Integer
' On Error Resume Next
'
' For i = 0 To List2.ListCount - 1
' If List2.Selected(i) = True Then
' judgeList List1, List2.List(i)
' 'List1.Selected(List1.ListCount - 1) = True
' End If
' Next i
'
' For i = List2.ListCount - 1 To 0 Step -1
' If List2.Selected(i) = True Then
' List2.Selected(i) = False
' List2.RemoveItem List2.ListIndex
' End If
' Next i
Dim i As Integer
On Error Resume Next
Dim stmp As String
Dim nCount As Integer
nCount = List2.ListCount - 1
Dim sList() As String
ReDim sList(nCount)
For i = 0 To List2.ListCount - 1
sList(i) = List2.List(i)
If List2.Selected(i) = True Then
judgeList List1, List2.List(i)
stmp = stmp & "'" & List2.List(i) & "',"
End If
Next i
stmp = Left(stmp, Len(stmp) - 1)
List2.Clear
For i = 0 To nCount
If InStr(stmp, "'" & sList(i) & "'") Then
Else
List2.AddItem sList(i)
End If
Next i
End Sub
Private Sub DTPicker1_CloseUp(Index As Integer)
Select Case Index
Case 0
Dim d As Date
d = DateAdd("m", 1, DTPicker1(0).Value)
'DTPicker1(1).Value = DateSerial(Year(d), Month(d), 1) - 1
DTPicker1(1).Value = DTPicker1(0).Value
End Select
End Sub
Private Sub Form_Load()
Screen.MousePointer = vbHourglass
'strConn = SQLcon
'strConn0 = SQLcon0
Set mDB = New mDB
mDB.InitDB_RY strconnDR
'Debug.Print strconnDR
strSQL = "select dptid,dptname from depart where ify=1 order by dptname asc"
Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
'Debug.Print adoprimaryRS.RecordCount
' With DataCombo1(0)
' Set .RowSource = adoprimaryRS
' .BoundColumn = "dptid"
' .ListField = "dptname"
' .Refresh
' End With
With adoprimaryRS
.MoveFirst
Do Until .EOF
List1.AddItem .Fields("dptname").Value
.MoveNext
Loop
End With
' strSQL = "select max(cdatetime) as maxdate from empcrdtm" '' order by begdate asc"
' Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
' DTPicker1(0).Value = Format(adoprimaryRS.Fields("maxdate").Value + 1, "yyyy-mm-dd") ''' Date
' ' DTPicker1(1).Value = Date
' ' Option1(0).Value = True
' ' SETIMER1(0).Text = "00:00:01"
' ' SETIMER1(1).Text = "23:59:59"
' strSQL = "select * from wktm2" '' order by begdate asc"
strSQL = "select * from wktm where wktmid=2"
Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
' SETIMER1(0).Text = TimeSerial(Hour(adoprimaryRS("bgnwktm1").Value), Minute(adoprimaryRS("bgnwktm1").Value), 0) '''' "00:00:01"
' SETIMER1(1).Text = TimeSerial(Hour(adoprimaryRS("bgntm1").Value), Minute(adoprimaryRS("bgntm1").Value), 0) '''' "00:00:01""23:59:59"
' SETIMER1(2).Text = TimeSerial(Hour(adoprimaryRS("endtm1").Value), Minute(adoprimaryRS("endtm1").Value), 0) '''' "00:00:01""23:59:59"
' SETIMER1(3).Text = TimeSerial(Hour(adoprimaryRS("endwktm1").Value), Minute(adoprimaryRS("endwktm1").Value), 0) '''' "00:00:01"
' SETIMER1(4).Text = TimeSerial(Hour(adoprimaryRS("bgnwktm2").Value), Minute(adoprimaryRS("bgnwktm2").Value), 0) '''' "00:00:01"
' SETIMER1(5).Text = TimeSerial(Hour(adoprimaryRS("bgntm2").Value), Minute(adoprimaryRS("bgntm2").Value), 0) '''' "00:00:01""23:59:59"
' SETIMER1(6).Text = TimeSerial(Hour(adoprimaryRS("endtm2").Value), Minute(adoprimaryRS("endtm2").Value), 0) '''' "00:00:01""23:59:59"
' SETIMER1(7).Text = TimeSerial(Hour(adoprimaryRS("endwktm2").Value), Minute(adoprimaryRS("endwktm2").Value), 0) '''' "00:00:01"
' SETIMER1(8).Text = TimeSerial(Hour(adoprimaryRS("bgnwktm3").Value), Minute(adoprimaryRS("bgnwktm3").Value), 0) '''' "00:00:01"
' SETIMER1(9).Text = TimeSerial(Hour(adoprimaryRS("bgntm3").Value), Minute(adoprimaryRS("bgntm3").Value), 0) '''' "00:00:01""23:59:59"
' SETIMER1(10).Text = TimeSerial(Hour(adoprimaryRS("endtm3").Value), Minute(adoprimaryRS("endtm3").Value), 0) '''' "00:00:01""23:59:59"
' SETIMER1(11).Text = TimeSerial(Hour(adoprimaryRS("endwktm3").Value), Minute(adoprimaryRS("endwktm3").Value), 0) '''' "00:00:01"
CenterForm Me
' Debug.Print DateDiff("n", SETIMER1(0).Text, SETIMER1(1).Text)
'''''''將人員表數據導入sqlserver數據庫
''strSQL2 = "delete from emply2"
''Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
''''''''''***********************************一定要是ACCESS等桌面數據庫，絕對位置，單引號***********************************
'' Dim MD As New mDB
'' MD.InitDB
'' strSQL = "select * into emppp in 'e:\sjk\data\hisdata1.mdb' from emply2"
''' adoprimaryRS.Save emp.rst
''MD.MakeTables strSQL, "emppp"
''''
''strSQL = "select * from emppp"
''MD.CreateRS adoprimaryRS, strSQL
''''''''''**********************************************************************
''Debug.Print adoprimaryRS.RecordCount
''
''strSQL2 = "select * from emply2"
''Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
''With adoprimaryRS
'' .MoveFirst
''Do Until .EOF
'' adoPrimaryRS2.AddNew
'' adoPrimaryRS2.Fields("ifin").Value = .Fields("ifin").Value
'' adoPrimaryRS2.Fields("partname").Value = .Fields("partname").Value
'' adoPrimaryRS2.Fields("emplyid").Value = "00" & .Fields("emplyid").Value
'' adoPrimaryRS2.Fields("emplyname").Value = .Fields("emplyname").Value
'' adoPrimaryRS2.Fields("indate").Value = .Fields("indate").Value
'' adoPrimaryRS2.Fields("outdate").Value = .Fields("outdate").Value
'' adoPrimaryRS2.Fields("gangwei").Value = .Fields("gangwei").Value
'' adoPrimaryRS2.Update
'' .MoveNext
''Loop
''End With
''Set MD = Nothing
'strSQL = "select dptname as 部門,emplyid as 工號,emplyname as 姓名,serial as 卡序列號 from depart,emply where depart.dptid=emply.dptid"
'
'Dim o As New ToExcel
''strSQL = "select * from emply where emplyid not in (select emplyid from emply2)"
'Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
'Debug.Print adoprimaryRS.RecordCount
'o.ToExcel adoprimaryRS, "不匹配", "不在新表中"
'
'strSQL = "select * from emply2 where emplyid not in (select emplyid from emply)"
'Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
'Debug.Print adoprimaryRS.RecordCount
'o.ToExcel adoprimaryRS, "不匹配", "不在表中"
'Set o = Nothing
'
strSQL = "select * from emply" ''''2 where emplyid not in (select emplyid from emply)"
Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
Debug.Print adoprimaryRS.RecordCount
'Dim m_sConnect As String
'm_sConnect = "PROVIDER=MSDataShape;Data PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=z:\data\hisdata1.mdb;Jet OLEDB:Database Password=notopen;" '''''用的是ODBC驅動程序
'
'strSQL = "select * into emplyww in """ & m_sConnect & """ from emply2 where outdate is null" ''''2 where emplyid not in (select emplyid from emply)"
'Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
'Database_Refresh 0
'Debug.Print strSQL
'
Screen.MousePointer = 0
Dim d As Date
d = DateAdd("m", -1, Date)
DTPicker1(0).Value = DateSerial(Year(d), Month(d), 1)
DTPicker1(1).Value = DateSerial(Year(Date), Month(Date), 1) - 1
ProgressBar1.Value = 0
ProgressBar1.Max = 100
End Sub
Private Sub Form_Unload(Cancel As Integer)
Screen.MousePointer = vbDefault
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -