Form 1 Source :
Dim WithEvents bd1 As Recordset
Private Sub Combo1_Click()
On Error Resume Next
bd1.UpdateBatch adAffectAll
bd1.MoveLast
End Sub
Private Sub Combo1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
DataGrid1.SetFocus
End If
End Sub
Private Sub Command1_Click()
On Error Resume Next
bd1.AddNew
End Sub
Private Sub DataGrid1_AfterColEdit(ByVal ColIndex As Integer)
On Error Resume Next
Dim stbd As Date
Dim stobd As Date
Dim eff As Double
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security
Info=False;Data Source=" & Form2.Text1.Text
Adodc1.RecordSource = "Select* from equipment"
Adodc1.Refresh
Do While Adodc1.Recordset.EOF = False
If DataGrid1.Columns(2) = Adodc1.Recordset![Number] Then
DataGrid1.Columns(3) = Adodc1.Recordset![model]
DataGrid1.Columns(4) = Adodc1.Recordset![Type]
End If
Adodc1.Recordset.MoveNext
Loop
On Error Resume Next
If DataGrid1.Columns(10) = "" Then
DataGrid1.Columns(10) = "hh:mm"
DataGrid1.Columns(11) = "0"
Else
eff = Format(eff, "0.00")
stbd = DataGrid1.Columns(9).Text
stobd = DataGrid1.Columns(10).Text
If DataGrid1.Columns(10) = "hh:mm" Then
DataGrid1.Columns(11) = "0"
Else
If Hour(stobd) - Hour(stbd) < 0 Then
eff = ((Hour(stobd) - Hour(stbd)) + 24) + ((Minute(stobd) - Minute(stbd) + 60)
/ 60)
DataGrid1.Columns(11).Text = eff
DataGrid1.Columns(11).Text = Format(eff, "0.00")
Else
eff = ((Hour(stobd) - Hour(stbd))) + ((Minute(stobd) - Minute(stbd) + 60) / 60)
- 1
DataGrid1.Columns(11).Text = eff
DataGrid1.Columns(11).Text = Format(eff, "0.00")
End If
End If
End If
If DataGrid1.Columns(11) = "0" Then
DataGrid1.Columns(12).Text = "ON GOING"
Else
DataGrid1.Columns(12).Text = "FINISH"
End If
If DataGrid1.Columns(12).Text = "ONGOING" Then
DataGrid1.Columns(12).DividerStyle = dbgLightGrayLine
End If
End Sub
Private Sub DataGrid1_BeforeColEdit(ByVal ColIndex As Integer, ByVal KeyAscii
As Integer, Cancel As Integer)
Select Case ColIndex
Case 7
Form4.Show
Case 14
Form7.Show
End Select
End Sub
Private Sub DataGrid1_ButtonClick(ByVal ColIndex As Integer)
Select Case ColIndex
Case 7
Form4.Show
Case 14
Form7.Show
End Select
End Sub
Private Sub DataGrid1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub
Private Sub Ex_Click()
Unload Me
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Combo1.SetFocus
End If
DTPicker1 = Date
End Sub
Private Sub Form_Load()
On Error Resume Next
Combo1.AddItem "Sumo"
Dim db As New Connection
Set db = New Connection
db.Open "PROVIDER=MSDataShape;Data Provider=Microsoft.Jet.OLEDB.3.51;Persist
Security Info=False;Data Source=" & Form2.Text1.Text
Set bd1 = New Recordset
bd1.Open "shape{select date, project from bd} as parentcmd append ({Select
date, project, eqnum, eqmodel, eqtype, bds, bdc, bdtype, description, startbd,
stopbd, effbd, status,startdate , location, remark from bd} as childcmd relate
date to date, project to project) as childcmd", db, adOpenStatic,
adLockOptimistic
Set DTPicker1.DataSource = bd1
Set Combo1.DataSource = bd1
With DataGrid1
Set .DataSource = bd1("childcmd").UnderlyingValue
.AllowAddNew = True
.AllowDelete = True
.AllowUpdate = True
.Columns(0).Width = 1000
.Columns(1).Width = 800
.Columns(2).Width = 800
.Columns(5).Width = 800
.Columns(6).Width = 800
.Columns(9).Width = 800
.Columns(10).Width = 800
.Columns(11).Width = 800
.Columns(8).Width = 3000
.Columns(9).Alignment = dbgRight
.Columns(10).Alignment = dbgRight
.Columns(11).Alignment = dbgRight
.Columns(7).Width = 3000
.Columns(7).Button = True
.Columns(14).Button = True
End With
End Sub
Private Sub Form_Resize()
On Error Resume Next
DataGrid1.Width = Form1.Width - 200
DataGrid1.Left = 50
DataGrid1.Top = 1200
DataGrid1.Height = Form1.Height - 1500 - 1000
End Sub
Form2 code
Private Sub Command1_Click()
With dl1
.ShowOpen
End With
Text1.Text = dl1.FileName
End Sub
Private Sub Command2_Click()
Me.Hide
End Sub
Private Sub Command3_Click()
Me.Hide
End Sub
Private Sub Form_Load()
Me.Left = (Screen.Width / 2) - (Me.Width / 2)
Me.Top = (Screen.Height / 2) - (Me.Height / 2)
End Sub
Private Sub Form_LostFocus()
Me.SetFocus
End Sub
form3 code
Private Sub Command1_Click()
On Error Resume Next
ListView1.ListItems.Clear
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" &
Form2.Text1.Text
Adodc1.RecordSource = "Select date, project, eqnum, eqmodel, eqtype, bds, bdc,
bdtype, description, startbd, stopbd, effbd, status, startdate, location,
remark from bd1"
Adodc1.Refresh
Do While Adodc1.Recordset.EOF = False
If Text1.Text = Adodc1.Recordset![Date] Then
With ListView1
.ListItems.Add 1, , Adodc1.Recordset![Eqnum]
.ListItems(1).ListSubItems.Add , , Adodc1.Recordset![Eqmodel]
.ListItems(1).ListSubItems.Add , , Adodc1.Recordset![EQTYPE]
.ListItems(1).ListSubItems.Add , , Adodc1.Recordset![bds]
.ListItems(1).ListSubItems.Add , , Adodc1.Recordset![BDC]
.ListItems(1).ListSubItems.Add , , Adodc1.Recordset![bdtype]
.ListItems(1).ListSubItems.Add , , Adodc1.Recordset![Description]
.ListItems(1).ListSubItems.Add , , Adodc1.Recordset![startbd]
.ListItems(1).ListSubItems.Add , , Adodc1.Recordset![stopbd]
.ListItems(1).ListSubItems.Add , , Adodc1.Recordset![effbd]
.ListItems(1).ListSubItems.Add , , Adodc1.Recordset![Status]
.ListItems(1).ListSubItems.Add , , Adodc1.Recordset![startdate]
.ListItems(1).ListSubItems.Add , , Adodc1.Recordset![location]
.ListItems(1).ListSubItems.Add , , Adodc1.Recordset![Remark]
.Sorted = False
End With
End If
Adodc1.Recordset.MoveNext
Loop
End Sub
Private Sub Command2_Click()
Adodc2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" &
Form2.Text1.Text
Adodc2.RecordSource = "Select date, tdate, project, eqnum, eqmodel, eqtype,
bds, bdc, bdtype, description, startbd, stopbd, effbd, status, startdate,
location, remark from bd1 Where Tdate='" & DTPicker1 & "'"
With DataReport1
Set .DataSource = Adodc2
.LeftMargin = 0
.RightMargin = 0
.Width = 2500
.Height = 2500
End With
DataReport1.Show
End Sub
Private Sub Command3_Click()
End Sub
Private Sub DTPicker1_Change()
Text1.Text = DTPicker1
End Sub
Private Sub Form_Load()
Text1.Text = DTPicker1
Me.Left = (Screen.Width / 2) - (Me.Width / 2)
Me.Top = (Screen.Height / 2) - (Me.Height / 2)
With ListView1
.View = lvwReport
.ColumnHeaders.Add 1, , "EQNUM"
.ColumnHeaders.Add 2, , "EQMODEL"
.ColumnHeaders.Add 3, , "EQTYPE"
.ColumnHeaders.Add 4, , "BDS", 800
.ColumnHeaders.Add 5, , "BDC", 800
.ColumnHeaders.Add 6, , "BDTYPE", 3000
.ColumnHeaders.Add 7, , "DESCRIPTION", 5000
.ColumnHeaders.Add 8, , "START", 1000, dbgRight
.ColumnHeaders.Add 9, , "STOP", 1000
.ColumnHeaders.Add 10, , "B/D TIME", 1000, dbgRight
.ColumnHeaders.Add 11, , "STATUS"
.ColumnHeaders.Add 12, , "STARTDATE"
.ColumnHeaders.Add 13, , "LOCATION"
.ColumnHeaders.Add 14, , "REMARK"
.GridLines = True
.FullRowSelect = True
.AllowColumnReorder = False
End With
End Sub
Private Sub Form_Resize()
On Error Resume Next
With ListView1
.Width = Me.Width - 300
.Left = 50
.Top = 1250
.Height = Me.Height - 2500
End With
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As
MSComctlLib.ColumnHeader)
Select Case ColumnHeader
Case "EQNUM"
ListView1.Sorted = True
If ListView1.SortOrder = lvwDescending Then
ListView1.SortOrder = lvwAscending
Else
ListView1.SortOrder = lvwDescending
End If
Case "EQTYPE"
If ListView1.SortOrder = lvwDescending Then
ListView1.SortOrder = lvwAscending
Else
ListView1.SortOrder = lvwDescending
End If
ListView1.Sorted = True
End Select
End Sub
form4 code
Private Sub Form_Load()
On Error Resume Next
Form1.Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist
Security Info=False;Data Source=" & Form2.Text1.Text
Form1.Adodc1.RecordSource = "Select btype, btdesc from type"
Form1.Adodc1.Refresh
Do While Form1.Adodc1.Recordset.EOF = False
List1.AddItem Form1.Adodc1.Recordset![btype]
Form1.Adodc1.Recordset.MoveNext
Loop
End Sub
Private Sub List1_DblClick()
Form1.DataGrid1.Columns(7).Text = List1.List(List1.ListIndex)
Unload Me
End Sub
Private Sub List1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Form1.DataGrid1.Columns(7).Text = List1.List(List1.ListIndex)
Unload Me
End If
End Sub
form5 code
Private Sub DataGrid1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub
Private Sub Form_Load()
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security
Info=False;Data Source=" & Form2.Text1.Text
Adodc1.RecordSource = "Select number, model, type from equipment"
Adodc1.Refresh
With DataGrid1
Set .DataSource = Adodc1
.AllowAddNew = True
.AllowDelete = True
.AllowUpdate = True
End With
End Sub
Private Sub Form_Resize()
On Error Resume Next
DataGrid1.Top = 50
DataGrid1.Left = 50
DataGrid1.Width = Me.Width - 150
DataGrid1.Height = Me.Height
End Sub
form6 code
Private Sub DataGrid1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub
Private Sub Form_Load()
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security
Info=False;Data Source=" & Form2.Text1.Text
Adodc1.RecordSource = "Select btype, btdesc from type"
With DataGrid1
Set .DataSource = Adodc1
.Columns(0).Width = 5000
End With
End Sub
form6 code
Private Sub Form_Load()
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" &
Form2.Text1.Text
Adodc1.RecordSource = "Select Lokasi from lokasi"
Adodc1.Refresh
Do While Adodc1.Recordset.EOF = False
List1.AddItem Adodc1.Recordset![lokasi]
Adodc1.Recordset.MoveNext
Loop
End Sub
Private Sub List1_DblClick()
Form1.DataGrid1.Columns(14).Text = List1.List(List1.ListIndex)
Unload Me
End Sub
Private Sub List1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Form1.DataGrid1.Columns(14).Text = List1.List(List1.ListIndex)
Unload Me
End If
End Sub
MDI Form code
Private Sub CDB_Click()
Form2.Show
End Sub
Private Sub Command1_Click()
Form1.Show
End Sub
Private Sub Command2_Click()
Form5.Show
End Sub
Private Sub Command3_Click()
Form3.Show
End Sub
Private Sub Command4_Click()
Form6.Show
End Sub
Private Sub Ex_Click()
Unload Me
End Sub
Private Sub MDIForm_Load()
Form2.Show
Form2.SetFocus
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
Unload Form4
End Sub
Private Sub OIF_Click()
Form1.Show
End Sub
Private Sub Picture1_Click()
End Sub
Private Sub SBD_Click()
Form3.Show
End Sub
Private Sub Timer1_Timer()
Dim lp32 As POINTAPI
Call GetCursorPos(lp32)
Label1.Caption = "X - Position : " & lp32.x
Label2.Caption = "Y - Position : " & lp32.y
Label3.Caption = Time
Label4.Caption = Date
End Sub
module
Declare Function WindowFromPointXY Lib "User32" Alias "WindowFromPoint" (ByVal
xPoint As Long, ByVal yPoint As Long) As Long
Type POINTAPI
x As Long
y As Long
End Type
Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
dan 1 buah report
kalo ada yang lebih hemat info nya ya ...
[Non-text portions of this message have been removed]
