📄 frmjjbb.frm
字号:
DataGrid1.Columns(0).Value = ID + j
DataGrid1.Columns(1).Value = DataGrid2.Columns(1).Value
DataGrid1.Columns(2).Value = Format(DTPicker1.Value, "yyyy-mm-dd")
DataGrid1.Columns(3).Value = ZBBC
DataGrid1.Columns(4).Value = DataGrid2.Columns(4).Value
DataGrid1.Columns(5).Value = Trim(DataGrid2.Columns(5).Value)
DataGrid1.Columns(6).Value = ID + j
j = j + 1
Adodc2.Recordset.MoveNext
Loop
End If
End If
End If
If Adodc1.Recordset.EOF Then
Else
Adodc1.Recordset.Update
End If
Adodc1.Refresh
DataGrid1.Refresh
Call sx
Call Close_link
End Sub
Private Sub Command5_Click()
Dim b(6) As String
'Unload ActiveReport2
'ActiveReport2.Show
'ActiveReport2.DataControl1.Source = "select * from xdgl_jjbfb where jbrq='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and jbbc='" & Trim(Combo2.Text) & "' "
'ActiveReport2.DataControl1.Refresh
'ActiveReport2.Label2 = Format(DTPicker1.Value, "yyyy年mm月dd日")
'ActiveReport2.Label3 = Trim(Combo2.Text)
'ActiveReport2.PageSetup
'ActiveReport2.MaxPages
Dim sendexcel As Excel.Application
Command5.Enabled = False
Set sendexcel = CreateObject("excel.Application")
sendexcel.Workbooks.Add
sql1 = Adodc1.RecordSource
Call Open_link
sendexcel.Columns("A:A").ColumnWidth = 3
sendexcel.Columns("B:B").ColumnWidth = 20
sendexcel.Columns("C:C").ColumnWidth = 20
sendexcel.Columns("D:D").ColumnWidth = 20
sendexcel.Columns("E:E").ColumnWidth = 20
b(0) = "交待事项"
b(1) = "系统事故及异常"
b(2) = "小水火电"
b(3) = "通信自动化"
b(4) = "保护及自动装置"
b(5) = "其它"
b(6) = "运行方式"
j = 3
For i = 0 To 6
sql1 = "select * from xdgl_jjbfb where jbrq='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and jbbc='" & Trim(Combo2.Text) & "' and jllx='" & b(i) & "' order by jlxh"
Set RS = ZHCX.Execute(sql1, 0)
Debug.Print sql1
If Not RS.EOF Then
s_a = "A" & CStr(j) & ":E" & CStr(j)
sendexcel.Range(s_a).Select
With sendexcel.Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = True
End With
sendexcel.Cells(j, 1).Value = b(i)
sendexcel.Range(s_a).Select
sendexcel.Selection.Font.Bold = True
With sendexcel.Selection.Font
.Name = "楷体_GB2312"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
j = j + 1
Do While Not RS.EOF
s_a = "A" & CStr(j) & ":E" & CStr(j)
sendexcel.Range(s_a).Select
With sendexcel.Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = True
End With
If IsNull(RS(5)) Then
sendexcel.Cells(j, 1).Value = ""
Else
sendexcel.Cells(j, 1).Value = CStr(RS(1)) + "." + CStr(Trim(RS(5)))
End If
s_a = CStr(j) + ":" + CStr(j)
If Len(CStr(RS(1)) + "." + CStr(Trim(RS(5)))) < 60 Then
sendexcel.Rows(s_a).RowHeight = 12
Else
Debug.Print Len(CStr(RS(1)) + "." + CStr(Trim(RS(5))))
sendexcel.Rows(s_a).RowHeight = 25
End If
sendexcel.Range(s_a).Select
With sendexcel.Selection.Font
.Name = "楷体_GB2312"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
RS.MoveNext
j = j + 1
Loop
If RS.State Then
RS.Close
End If
End If
Next i
If j <= 43 Then
For i = j To 43
s_a = "A" & CStr(i) & ":E" & CStr(i)
sendexcel.Range(s_a).Select
With sendexcel.Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = True
End With
Next i
j = 43
End If
sendexcel.Sheets("Sheet1").Select
With sendexcel.ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.RightFooter = ""
.CenterFooter = ""
.LeftMargin = Application.InchesToPoints(0.63)
.RightMargin = Application.InchesToPoints(0.32)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(0.54)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
' .PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
End With
s_a = "A3:E" & CStr(j - 1)
sendexcel.Range(s_a).Select
sendexcel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
sendexcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With sendexcel.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With sendexcel.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With sendexcel.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With sendexcel.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With sendexcel.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With sendexcel.Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
j = j + 1
If j > 44 Then
j = 44
End If
sendexcel.Cells(j, 2).FormulaR1C1 = "交 班 人:"
sendexcel.Cells(j, 4).FormulaR1C1 = "接 班 人:"
sendexcel.Range("A1:E1").Select
With sendexcel.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
sendexcel.Rows("1:1").RowHeight = 30
sendexcel.Cells(1, 1).Value = "交接班记录"
sendexcel.Range("A1:E1").Select
With sendexcel.ActiveCell.Font
.Name = "楷体_GB2312"
.FontStyle = "加粗"
.Size = 24
.ColorIndex = 11
End With
sendexcel.Range("A1:E1").Select
sendexcel.Selection.Font.ColorIndex = 0
sendexcel.Selection.Font.Bold = True
sendexcel.Cells(2, 3).FormulaR1C1 = Format(DTPicker1.Value, "yyyy年mm月dd日")
sendexcel.Cells(2, 4).FormulaR1C1 = Trim(Combo2.Text)
Select Case DatePart("w", CDate(DTPicker1.Value))
Case 2
temp = "一"
Case 3
temp = "二"
Case 4
temp = "三"
Case 5
temp = "四"
Case 6
temp = "五"
Case 7
temp = "六"
Case 1
temp = "日"
End Select
sendexcel.Cells(2, 5).Value = "星期" + CStr(temp)
sendexcel.Visible = True
sendexcel.ActiveWindow.SelectedSheets.PrintPreview
Call Close_link
Command5.Enabled = True
End Sub
Private Sub DataGrid1_DblClick()
If Adodc1.Recordset.EOF Then
Exit Sub
End If
If IsNull(DataGrid1.Columns(5).Value) Then
Text3.Text = ""
Else
Text3.Text = DataGrid1.Columns(5).Value
Text4.Text = DataGrid1.Columns(0).Value
Combo1.Text = DataGrid1.Columns(4).Value
End If
End Sub
Private Sub DataGrid1_LostFocus()
If Adodc1.Recordset.EOF Then
Else
Adodc1.Recordset.Update
End If
End Sub
Private Sub DTPicker1_Change()
Call Check1_Click
End Sub
Private Sub DTPicker1_Click()
Call Check1_Click
End Sub
Private Sub DTPicker2_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
Adodc2.ConnectionString = "PROVIDER=MSDASQL;dsn=ddmis;uid=mis;pwd=mis005;database=zhcx"
If Option1.Value Then
Adodc2.RecordSource = "select * from xdgl_zbjlb where dlsj='" & Format(DTPicker2.Value, "yyyy-mm-dd") & "' and zbbc='" & Trim(Combo3.Text) & "'"
Adodc2.Refresh
DataGrid2.Refresh
Call sx1
Else
Adodc2.RecordSource = "select * from xdgl_jjbfb where jbrq='" & Format(DTPicker2.Value, "yyyy-mm-dd") & "' and jbbc='" & Trim(Combo3.Text) & "'"
Adodc2.Refresh
DataGrid2.Refresh
Call sx2
End If
End Sub
Private Sub DTPicker2_Click()
Call Option1_Click
End Sub
Private Sub Form_Load()
On Error Resume Next
Adodc1.ConnectionString = "PROVIDER=MSDASQL;dsn=ddmis;uid=mis;pwd=mis005;database=zhcx"
Adodc2.ConnectionString = "PROVIDER=MSDASQL;dsn=ddmis;uid=mis;pwd=mis005;database=zhcx"
Adodc1.RecordSource = "select * from xdgl_jjbfb where jbrq='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' "
Adodc1.Refresh
Combo2.Clear
Combo2.AddItem "早班"
Combo2.AddItem "中班"
Combo2.AddItem "晚班"
Combo2.Text = ZBBC
Combo3.Clear
Combo3.AddItem "早班"
Combo3.AddItem "中班"
Combo3.AddItem "晚班"
Combo3.Text = ZBBC
DTPicker1.Value = Format(Now, "yyyy-mm-dd")
DTPicker2.Value = Format(Now, "yyyy-mm-dd")
Combo1.Clear
Combo1.AddItem "交待事项"
Combo1.AddItem "系统事故及异常"
Combo1.AddItem "小水火电"
Combo1.AddItem "通信自动化"
Combo1.AddItem "保护及自动装置"
Combo1.AddItem "其它"
Combo1.AddItem "运行方式"
Combo1.ListIndex = 0
Text1.Text = cname
Call Option1_Click
Call sx
End Sub
Sub sx()
DataGrid1.Columns(0).Visible = False
DataGrid1.Columns(1).Caption = "序号"
DataGrid1.Columns(1).Width = 700
DataGrid1.Columns(2).Visible = False
DataGrid1.Columns(3).Visible = False
DataGrid1.Columns(4).Visible = True
DataGrid1.Columns(4).Caption = "记录类型"
DataGrid1.Columns(5).Caption = "记录内容"
DataGrid1.Columns(5).Width = 10000
DataGrid1.Columns(6).Visible = False
End Sub
Private Sub Option1_Click()
Adodc2.ConnectionString = "PROVIDER=MSDASQL;dsn=ddmis;uid=mis;pwd=mis005;database=zhcx"
If Option1.Value Then
Adodc2.RecordSource = "select * from xdgl_zbjlb where dlsj='" & Format(DTPicker2.Value, "yyyy-mm-dd") & "' and zbbc='" & Trim(Combo3.Text) & "'"
Adodc2.Refresh
DataGrid2.Refresh
Call sx1
Else
Adodc2.RecordSource = "select * from xdgl_jjbfb where jbrq='" & Format(DTPicker2.Value, "yyyy-mm-dd") & "' and jbbc='" & Trim(Combo3.Text) & "'"
Adodc2.Refresh
DataGrid2.Refresh
Call sx2
End If
End Sub
Sub sx1()
DataGrid2.Columns(0).Visible = False
DataGrid2.Columns(2).Visible = False
DataGrid2.Columns(3).Visible = False
DataGrid2.Columns(4).Visible = False
DataGrid2.Columns(5).Visible = False
DataGrid2.Columns(6).Visible = False
DataGrid2.Columns(7).Visible = False
DataGrid2.Columns(8).Width = 6200
DataGrid2.Columns(9).Visible = False
DataGrid2.Columns(10).Visible = False
DataGrid2.Columns(1).Caption = "序号"
DataGrid2.Columns(8).Caption = "内容"
End Sub
Sub sx2()
DataGrid2.Columns(0).Visible = False
DataGrid2.Columns(2).Visible = False
DataGrid2.Columns(3).Visible = False
DataGrid2.Columns(4).Visible = False
DataGrid2.Columns(6).Visible = False
DataGrid2.Columns(1).Caption = "序号"
DataGrid2.Columns(5).Caption = "内容"
DataGrid2.Columns(5).Width = 6200
End Sub
Private Sub Option2_Click()
Call Option1_Click
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -