📄 +
字号:
_ExtentY = 1005
ButtonWidth = 820
ButtonHeight = 953
AllowCustomize = 0 'False
Wrappable = 0 'False
Appearance = 1
Style = 1
ImageList = "ImageList1"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 11
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "设置"
Key = "setup"
Object.ToolTipText = "打印页面设置"
ImageKey = "setup"
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "打印"
Key = "print"
Object.ToolTipText = "打印当前单据或Ctrl+P"
ImageKey = "print"
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "预览"
Key = "view"
ImageKey = "view"
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.Visible = 0 'False
Caption = "保存"
Key = "save"
ImageKey = "save"
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.Visible = 0 'False
Caption = "修改"
Key = "edit"
ImageKey = "edit"
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.Visible = 0 'False
Caption = "放弃"
Key = "esc"
ImageKey = "esc"
EndProperty
BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.Visible = 0 'False
Style = 3
EndProperty
BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.Visible = 0 'False
Caption = "定位"
Key = "seach"
ImageKey = "dw"
EndProperty
BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "帮助"
Key = "help"
ImageKey = "help"
EndProperty
BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退出"
Key = "exit"
ImageKey = "exit"
EndProperty
EndProperty
BorderStyle = 1
Begin MSComctlLib.Toolbar GsToolbar
Height = 540
Left = 6720
TabIndex = 3
Top = 0
Width = 1695
_ExtentX = 2990
_ExtentY = 953
ButtonWidth = 1455
ButtonHeight = 953
AllowCustomize = 0 'False
Appearance = 1
Style = 1
ImageList = "ImageList1"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 2
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "保存格式"
Key = "bcgs"
ImageKey = "bcgs"
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "默认列宽"
Key = "hfmrgs"
ImageKey = "mrlk"
EndProperty
EndProperty
End
End
Begin VB.Label Lab_OperStatus
BackColor = &H000080FF&
Caption = "1"
Height = 345
Left = 9240
TabIndex = 2
Top = 840
Visible = 0 'False
Width = 345
End
End
Attribute VB_Name = "JC_FrmTagSetup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Option Explicit
Dim iRow As Integer '网格行
Dim iCol As Integer '网格列
'以下为固定使用变量
Dim Dyymctbl As New DY_Dyymsz '打印页面窗体变量
Dim GridCode As String '显示网格网格代码
Dim GridInf() As Variant '整个网格设置信息
Dim Tsxx As String '系统提示信息
Dim Qslz As Long '网格隐藏(非操作显示)列数
Dim Sjhgd As Double '网格数据行高度
Dim Sfxshjwg As Boolean '是否显示合计网格
Dim GridBoolean() As Boolean '网格列信息(布尔型)
Dim GridStr() As String '网格列信息(字符型)
Dim GridInt() As Integer '网格列信息(整型)
Dim Szzls As Integer '数组总列数(网格列数-1)
Dim Bln_Stop As Boolean '停止输出查询结果
Dim ReportTitle
Dim Cxnrrec As New ADODB.Recordset
Private Sub Form_KeyPress(KeyAscii As Integer) '控 制 焦 点 转 移
If DEBUG_FLAG = False Then On Error Resume Next
Dim jdzygs As Integer
jdzygs = 3
Select Case KeyAscii
Case vbKeyReturn
If Kjjdzy(jdzygs) Then
KeyAscii = 0
End If
Case 39 '屏蔽"'"
KeyAscii = 0
End Select
End Sub
Private Sub Form_Load()
If DEBUG_FLAG = False Then On Error Resume Next
'调入打印页面设置窗体
XtReportCode = "cwfx_TagSetup"
ReportTitle = "指标设置"
Load Dyymctbl
'调 入 网 格
GridCode = "cwfx_TagSetup"
Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
Qslz = GridInf(1)
Sjhgd = GridInf(2)
Sfxshjwg = GridInf(7)
Szzls = WglrGrid.Cols - 1
Call Cxnrtcwg
End Sub
Private Sub Cxnrtcwg() '查 询 内 容 填 充 网 格
If DEBUG_FLAG = False Then On Error Resume Next
Dim SqlStr As String
Dim Jsqte As Long
'查询连接串
SqlStr = "SELECT * FROM cwfx_TagInital ORDER BY ID "
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
With Cxnrrec
WglrGrid.Clear 1
WglrGrid.Rows = .RecordCount + WglrGrid.FixedRows
If .EOF And .BOF Then
Exit Sub
End If
Jsqte = WglrGrid.FixedRows
Do While Not .EOF
If Jsqte >= WglrGrid.Rows Then
WglrGrid.AddItem ""
End If
Call Jltcwg(Cxnrrec, Jsqte)
WglrGrid.RowHeight(Jsqte) = Sjhgd
.MoveNext
Jsqte = Jsqte + 1
Loop
End With
End Sub
Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long) '记录内容填充网格
If DEBUG_FLAG = False Then On Error Resume Next
'[以下为自定义部分
With Jlbrec
WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("Selected"))
WglrGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("RatioName"))
WglrGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("RatioType"))
WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("Unit"))
WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("Formula"))
End With
'以上为自定义部分]
End Sub
Private Sub SaveData()
If DEBUG_FLAG = False Then On Error Resume Next
Dim strSql As String '查询字符串
Dim i As Integer
With Cxnrrec
If .State = 1 Then .Close
.Open "SELECT * FROM cwfx_TagInital ORDER BY ID", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
.MoveFirst
For i = WglrGrid.FixedRows To WglrGrid.Rows - 1
!Selected = WglrGrid.TextMatrix(i, Sydz("001", GridStr(), Szzls))
!RatioName = WglrGrid.TextMatrix(i, Sydz("002", GridStr(), Szzls))
!RatioType = WglrGrid.TextMatrix(i, Sydz("003", GridStr(), Szzls))
!Unit = WglrGrid.TextMatrix(i, Sydz("004", GridStr(), Szzls))
!Formula = WglrGrid.TextMatrix(i, Sydz("005", GridStr(), Szzls))
.Update
.MoveNext
Next
End With
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call SaveData
End Sub
Private Sub Form_Resize()
On Error Resume Next
With Me.WglrGrid
.Width = Me.ScaleWidth
.Height = Me.ScaleHeight - .Top
End With
With Pic_Title
.Width = Me.ScaleWidth
End With
With GsToolbar
If Me.Width >= 6375 Then
.Left = Pic_Title.Width - .Width
End If
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
If DEBUG_FLAG = False Then On Error Resume Next
If Cxnrrec.State <> adStateClosed Then Cxnrrec.Close
Set Cxnrrec = Nothing
End Sub
Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button) '表格格式设置(通用)
If DEBUG_FLAG = False Then On Error Resume Next
Select Case Button.Key
Case "bcgs" '保存表格格式
Call Bcwggs(WglrGrid, GridCode)
Case "hfmrgs" '恢复默认格式
Call Hfmrgs(WglrGrid, GridCode)
End Select
End Sub
Private Sub WglrGrid_Click()
If DEBUG_FLAG = False Then On Error Resume Next
iRow = Me.WglrGrid.Row
Me.WglrGrid.Col = 0
Me.WglrGrid.CellChecked = IIf(Me.WglrGrid.CellChecked = flexChecked, flexUnchecked, flexChecked)
End Sub
Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button) '用户点击工具条
If DEBUG_FLAG = False Then On Error Resume Next
Select Case Button.Key
Case "setup"
Dyymctbl.Show vbModal
Case "print"
Call bbyl(False)
Case "view"
Call bbyl(True)
Case "help"
Case "exit"
Unload Me
End Select
End Sub
Private Sub bbyl(bbylte As Boolean) '报表打印预览
If DEBUG_FLAG = False Then On Error Resume Next
Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
Bbxbtgs = 1 '报 表 小 标 题 行 数
Bbbwhgs = 0 '报 表 表 尾 行 数
ReDim Bbxbt(1 To Bbxbtgs)
ReDim bbxbtzzxs(1 To Bbxbtgs)
If Bbbwhgs <> 0 Then
ReDim Bbbwh(1 To Bbbwhgs)
ReDim Bbbwhzzxs(1 To Bbbwhgs)
End If
Bbzbt = ReportTitle
Bbxbt(1) = " "
bbxbtzzxs(1) = 0 '报表行组织形式(0-居左 1-居中 2-居右)
Call Scyxsjb(WglrGrid) '生成报表数据
Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
If Not bbylte Then
Unload DY_Tybbyldy
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -