?? frmaccupgrade.frm

?? 用友u8財務源碼,用visual basic開發
?? FRM
?? 第 1 頁 / 共 4 頁
字號:
上一頁 1 2 34
End Sub
'輸出處理程序
Private Sub outputProc()
    If Not xmlInit Then
        Call initPrnXmlFile
    End If
    If xmlInit Then
        Dim sTypeList As String
        Dim sSizeList As String
        Dim i As Long
        Dim e As Long
    
        i = 0
        sTypeList = "10,10,10,10,8,10,10"
        sSizeList = "40,40,80,80,10,80,8"
        e = Printer.ExportToFile(i, sTypeList, sSizeList, "", "")
        xmlInit = False
    '    MsgBox e
    End If
End Sub
'保存用戶設置
Private Sub printer_SettingChanged(ByVal varLocalSettings As Variant, ByVal varModuleSettings As Variant)
    Dim xmlstr As String
    xmlstr = "<?xml version='1.0' standalone='yes' ?>"
    xmlstr = xmlstr & "<格式>"
    xmlstr = xmlstr & varLocalSettings
    xmlstr = xmlstr & varModuleSettings
    xmlstr = xmlstr & "</格式>"
    Dim rs As New ADODB.Recordset
    On Error GoTo Error0
    rs.Open "select * from prn_format where moduleid='accUpprn'", con, adOpenDynamic, adLockOptimistic
    rs("formatXml") = xmlstr
    rs.Update
    rs.Close
    Set rs = Nothing
    Exit Sub
Error0:
    If rs.State = adStateOpen Then
        rs.Close
    End If
    Set rs = Nothing
    MsgBox "打印設置保存失敗！"
End Sub
'設置打印格式
Private Function initStyleXml() As Boolean
    Dim rs As New ADODB.Recordset
    Dim PrnDom As New DOMDocument
    Dim xmlstr As String
    
    sqlstr = "select formatXml from PRN_format where moduleID='accUpprn'"
    rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
    If Not (rs.EOF Or rs.BOF) Then
        xmlstr = Trim(rs("formatXml"))
    Else
        xmlstr = "<?xml version=''1.0'' standalone=''yes'' ?>"
        xmlstr = xmlstr & "<格式>"
        xmlstr = xmlstr & "<打印設置 打印范圍=''全部'' 頁碼范圍=''1-1'' 打印份數=''1'' 壓縮=''是'' 多任務強制分頁=''否'' />"
        xmlstr = xmlstr & "<紙張設置 紙張類型=''9'' 紙張大小=''2100,2970'' 打印方向=''縱向'' 頁邊距=''300,200,200,200'' />"
        xmlstr = xmlstr & "<頁眉 對齊方式=''左'' 左頂點=''0,0'' 寬=''0'' 高=''100'' 字體名=''楷體_GB2312'' 字體大小=''12'' 顏色=''#000000'' 粗體=''否'' 斜體=''否'' 打印=''是'' />"
        xmlstr = xmlstr & "<標題 對齊方式=''中'' 左頂點=''0,200'' 寬=''0'' 高=''300'' 字體名=''黑體'' 字體大小=''24'' 顏色=''#000000'' 粗體=''是'' 斜體=''否'' 打印=''是'' /> "
        xmlstr = xmlstr & "<表頭 對齊方式=''左'' 左頂點=''0,500'' 寬=''1600'' 高=''200'' 字體名=''宋體'' 字體大小=''12'' 顏色=''#000000'' 粗體=''否'' 斜體=''否'' 打印=''是''>"
        xmlstr = xmlstr & "<字段 打印=''是'' 名字=''升級日期'' 對齊方式=''左'' 左頂點=''1100,500'' 寬=''800'' 高=''200'' 字體名=''黑體'' 字體大小=''16'' 顏色=''#000000'' 粗體=''否'' 斜體=''否'' 標題寬度=''0'' 下標線=''否'' />"
        'xmlstr = xmlstr & "<字段 打印=''是'' 名字=''生成單據名稱'' 對齊方式=''右'' 左頂點=''1200,650'' 寬=''600'' 高=''140'' />"
        xmlstr = xmlstr & "</表頭>"
        xmlstr = xmlstr & "<表體 左頂點=''0,700'' 寬=''0'' 高=''1400'' 固定行數=''0'' 列寬=''250,220,350,350,300,400,200''>"
        xmlstr = xmlstr & "<表體頭 對齊方式=''中'' 邊框風格=''783'' 邊框寬度=''2'' 行高=''140'' 字體名=''黑體'' 字體大小=''14'' 顏色=''#000000'' 粗體=''是'' 斜體=''否'' 打印=''是'' />"
        xmlstr = xmlstr & "<表體行 對齊方式=''左,左,左,左,左,左,左'' 邊框風格=''783'' 邊框寬度=''2'' 行高=''0'' 字體名=''Times New Roman'' 字體大小=''12'' 顏色=''#000000'' 粗體=''否'' 斜體=''否'' 打印=''是'' />"
        xmlstr = xmlstr & "<表體尾 對齊方式=''中'' 邊框風格=''735'' 邊框寬度=''2'' 行高=''140'' 字體名=''黑體'' 字體大小=''14'' 顏色=''#000000'' 粗體=''否'' 斜體=''否'' 打印=''是'' />"
        xmlstr = xmlstr & "</表體>"
'        xmlstr = xmlstr & "<表尾 對齊方式=''左'' 左頂點=''0,2200'' 寬=''1600'' 高=''200'' 字體名=''新宋體'' 字體大小=''12'' 顏色=''#000000'' 粗體=''否'' 斜體=''否'' 打印=''是''>"
'        xmlstr = xmlstr & "<字段 打印=''是'' 名字=''操作員'' 對齊方式=''左'' 左頂點=''50,2200'' 寬=''500'' 高=''200'' 字體名='''' 字體大小=''12'' 顏色=''#000000'' 粗體=''否'' 斜體=''否'' 標題寬度=''0'' 下標線=''否'' />"
'        xmlstr = xmlstr & "<字段 打印=''是'' 名字=''操作日期'' 對齊方式=''右'' 左頂點=''800,2200'' 寬=''600'' 高=''150'' 字體名='''' 字體大小=''12'' 顏色=''#000000'' 粗體=''否'' 斜體=''否'' 標題寬度=''0'' 下標線=''否'' />"
'        xmlstr = xmlstr & "</表尾>"
        xmlstr = xmlstr & "<頁腳 對齊方式=''右'' 左頂點=''0,2400'' 寬=''0'' 高=''170'' 字體名=''楷體_GB2312'' 字體大小=''10'' 顏色=''#000000'' 粗體=''否'' 斜體=''否'' 打印=''是'' />"
        xmlstr = xmlstr & "</格式>"
        sqlstr = "insert into PRN_format (moduleID,FormatXml) values('accUpprn','" & xmlstr & "');"
        On Error GoTo Error1
        con.BeginTrans
        con.Execute sqlstr
        con.CommitTrans
        xmlstr = "<?xml version='1.0' standalone='yes' ?>"
        xmlstr = xmlstr & "<格式>"
        xmlstr = xmlstr & "<打印設置 打印范圍='全部' 頁碼范圍='1-1' 打印份數='1' 壓縮='是' 多任務強制分頁='否' />"
        xmlstr = xmlstr & "<紙張設置 紙張類型='9' 紙張大小='2100,2970' 打印方向='縱向' 頁邊距='300,200,200,200' />"
        xmlstr = xmlstr & "<頁眉 對齊方式='左' 左頂點='0,0' 寬='0' 高='100' 字體名='楷體_GB2312' 字體大小='12' 顏色='#000000' 粗體='否' 斜體='否' 打印='是' />"
        xmlstr = xmlstr & "<標題 對齊方式='中' 左頂點='0,200' 寬='0' 高='300' 字體名='黑體' 字體大小='24' 顏色='#000000' 粗體='是' 斜體='否' 打印='是' /> "
        xmlstr = xmlstr & "<表頭 對齊方式='左' 左頂點='0,500' 寬='1600' 高='200' 字體名='宋體' 字體大小='12' 顏色='#000000' 粗體='否' 斜體='否' 打印='是'>"
        xmlstr = xmlstr & "<字段 打印='是' 名字='升級日期' 對齊方式='左' 左頂點='1100,500' 寬='800' 高='200' 字體名='黑體' 字體大小='16' 顏色='#000000' 粗體='否' 斜體='否' 標題寬度='0' 下標線='否' />"
        'xmlstr = xmlstr & "<字段 打印='是' 名字='生成單據名稱' 對齊方式='右' 左頂點='1200,650' 寬='600' 高='140' />"
        xmlstr = xmlstr & "</表頭>"
        xmlstr = xmlstr & "<表體 左頂點='0,700' 寬='0' 高='1400' 固定行數='0' 列寬='250,220,350,350,300,400,200'>"
        xmlstr = xmlstr & "<表體頭 對齊方式='中' 邊框風格='735' 邊框寬度='2' 行高='140' 字體名='黑體' 字體大小='14' 顏色='#000000' 粗體='是' 斜體='否' 打印='是' />"
        xmlstr = xmlstr & "<表體行 對齊方式='左,左,左,左,左,左,左' 邊框風格='783' 邊框寬度='2' 行高='0' 字體名='Times New Roman' 字體大小='12' 顏色='#000000' 粗體='否' 斜體='否' 打印='是' />"
        xmlstr = xmlstr & "<表體尾 對齊方式='中' 邊框風格='735' 邊框寬度='2' 行高='140' 字體名='黑體' 字體大小='14' 顏色='#000000' 粗體='否' 斜體='否' 打印='是' />"
        xmlstr = xmlstr & "</表體>"
'        xmlstr = xmlstr & "<表尾 對齊方式='左' 左頂點='0,1800' 寬='1600' 高='200' 字體名='新宋體' 字體大小='12' 顏色='#000000' 粗體='否' 斜體='否' 打印='是'>"
'        xmlstr = xmlstr & "<字段 打印='是' 名字='操作員' 對齊方式='左' 左頂點='50,1800' 寬='500' 高='200' 字體名='' 字體大小='12' 顏色='#000000' 粗體='否' 斜體='否' 標題寬度='0' 下標線='否' />"
'        xmlstr = xmlstr & "<字段 打印='是' 名字='操作日期' 對齊方式='右' 左頂點='800,1800' 寬='600' 高='150' 字體名='' 字體大小='12' 顏色='#000000' 粗體='否' 斜體='否' 標題寬度='0' 下標線='否' />"
'        xmlstr = xmlstr & "</表尾>"
        xmlstr = xmlstr & "<頁腳 對齊方式='右' 左頂點='0,2400' 寬='0' 高='170' 字體名='楷體_GB2312' 字體大小='10' 顏色='#000000' 粗體='否' 斜體='否' 打印='是' />"
        xmlstr = xmlstr & "</格式>"

    End If
    If PrnDom.loadXML(Trim(xmlstr)) Then
        PrnDom.Save App.Path & "\taccUpStyle.xml"
    Else
       initStyleXml = False
    End If
    initStyleXml = True
    
    rs.Close
    Set rs = Nothing
    Set PrnDom = Nothing
    Exit Function
Error1:
    initStyleXml = False
    con.RollbackTrans
    rs.Close
    Set rs = Nothing
    Set PrnDom = Nothing
End Function

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyF6
            If Shift = 0 And tlbTool.Buttons("save").Enabled Then
                Screen.MousePointer = vbHourglass
                Call saveProc
                Screen.MousePointer = vbDefault
            End If
        Case vbKeyF3
            If Shift = 0 And tlbTool.Buttons("search").Enabled Then
                If frmQuqeryAcc.m_accUpgrade = 0 Then
                    frmQuqeryAcc.m_accUpgrade = 1
                    frmQuqeryAcc.Show 1
                    frmQuqeryAcc.m_accUpgrade = 0
                    Call fillGrid(False)
                Else
                    MsgBox "賬號升級或賬號信息調整程序正在執行查詢操作！" & vbCrLf & "請稍后再執行查詢！", vbInformation, "賬號升級"
                End If
            End If
       Case vbKeyF4
            If Shift = 2 Then
                Unload Me
                Exit Sub
'            ElseIf Shift = 0 And tlbTool.Buttons("cancel").Enabled Then
'                Call CancelProc
            End If
        Case vbKeyF5
            If Shift = 0 And tlbTool.Buttons("cmdyulan").Enabled Then
                Screen.MousePointer = vbHourglass
                yulanProc
                Screen.MousePointer = vbDefault
            End If
        Case vbKeyP
            If Shift = 2 And tlbTool.Buttons("print").Enabled Then
                Call printProc
            End If
        Case vbKeyZ
            If Shift = 2 And tlbTool.Buttons("cancel").Enabled Then
                Screen.MousePointer = vbHourglass
                Call CancelProc
                Screen.MousePointer = vbDefault
            End If
        Case vbKeyO
            If Shift = 2 And tlbTool.Buttons("output").Enabled Then
                Call outputProc
            End If
        Case vbKeyV
            If Shift = 4 And tlbTool.Buttons("preview").Enabled Then
                Call previewProc
            End If
        Case vbKeyF1
            SendKeys "{F1 3}"
    End Select
    ocxCTBtool.RefreshEnable
End Sub

Private Sub tlbTool_ButtonClick(ByVal Button As MsComctlLib.Button)
    Select Case Button.key
        Case "print"
            printProc
        Case "preview"
            previewProc
        Case "output"
            outputProc
        Case "search"
            If frmQuqeryAcc.m_accUpgrade = 0 Then
                frmQuqeryAcc.m_accUpgrade = 1
                frmQuqeryAcc.Show 1
                frmQuqeryAcc.m_accUpgrade = 0
                Call fillGrid(False)
            Else
                MsgBox "賬號升級或賬號信息調整程序正在執行查詢操作！" & vbCrLf & "請稍后再執行查詢！", vbInformation, "賬號升級"
            End If
        Case "cmdyulan"
            Screen.MousePointer = vbHourglass
            yulanProc
            Screen.MousePointer = vbDefault
        Case "cancel"
            Screen.MousePointer = vbHourglass
            CancelProc
            Screen.MousePointer = vbDefault
        Case "save"
            Screen.MousePointer = vbHourglass
            SuperGrid1.ProtectUnload
            If error_Edit Then
                If errorNUM = 0 Then
                    MsgBox "請先改正輸入錯誤！", vbInformation, "賬號升級"
                    errorNUM = 1
                    SuperGrid1.row = selrow
                    SuperGrid1.col = selcol
                    SuperGrid1.SetFocus
                Else
                    errorNUM = 0
                End If
            Else
                saveProc
            End If
            Screen.MousePointer = vbDefault
        Case "help"
            SendKeys "{F1 3}"
        Case "exit"
            Unload Me
            Exit Sub
    End Select
    If Button.key <> "exit" Then
        ocxCTBtool.RefreshEnable
    End If
End Sub



Private Sub txtSjrq_GotFocus()
    If txtSjrq.Enabled Then
        cmdDateRef.Visible = True
    End If
End Sub

Private Sub txtSjrq_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyF2 And txtSjrq.Enabled Then
        cmdDateRef_Click
    ElseIf KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
        SuperGrid1.SetFocus
    End If
End Sub

Private Sub txtSjrq_LostFocus()
    If Trim(txtSjrq.Text) <> "" Then
        If DateCheck(Trim(txtSjrq.Text)) = "" Then
            MsgBox "升級日期輸入錯誤", vbInformation, "賬號升級"
            Exit Sub
        Else
            txtSjrq.Text = DateCheck(Trim(txtSjrq.Text))
        End If
    End If
End Sub

'set supergrid size and style

Private Sub initGrid()
    With SuperGrid1
        .TextMatrix(0, 0) = "舊賬戶號"
        .SetColProperty 0, 40, BrowNull
        .ColAlignment(0) = 3
        .TextMatrix(0, 1) = "新賬戶號"
        .SetColProperty 1, 50, BrowNull, EditNormal
        .ColAlignment(1) = 3
        .TextMatrix(0, 2) = "賬戶名稱"
        .SetColProperty 2, 80, BrowNull
        .ColAlignment(2) = 3
        .SetColProperty 3, 80, BrowNull
         .TextMatrix(0, 3) = "單位名稱"
       .ColAlignment(3) = 3
        .SetColProperty 4, 10, BrowNull, EditDate
        .TextMatrix(0, 4) = "開戶日期"
        .ColAlignment(4) = 3
        .TextMatrix(0, 5) = "開戶銀行"
        .SetColProperty 5, 80, BrowNull
        .ColAlignment(5) = 3
        .TextMatrix(0, 6) = "幣別"
        .SetColProperty 6, 8, BrowNull
        .ColAlignment(6) = 3
        .ReadOnly = True
    End With

End Sub

Private Sub loadstatic()
    Me.Icon = LoadResPicture(109, vbResIcon)
    cmdDateRef.Picture = LoadResPicture(1108, vbResBitmap)
    ImageList1.ListImages.Add , "print", LoadResPicture(314, vbResBitmap)
    ImageList1.ListImages.Add , "preview", LoadResPicture(312, vbResBitmap)
    ImageList1.ListImages.Add , "output", LoadResPicture(263, vbResBitmap)
    ImageList1.ListImages.Add , "cmdyulan", LoadResPicture(143, vbResBitmap)
    ImageList1.ListImages.Add , "search", LoadResPicture(331, vbResBitmap)
    ImageList1.ListImages.Add , "save", LoadResPicture(1145, vbResBitmap)
    ImageList1.ListImages.Add , "cancel", LoadResPicture(316, vbResBitmap)
    ImageList1.ListImages.Add , "help", LoadResPicture(396, vbResBitmap)
    ImageList1.ListImages.Add , "exit", LoadResPicture(1118, vbResBitmap)
    
    With tlbTool
        .Buttons("print").Caption = "打印"
        .Buttons("print").Image = "print"
        .Buttons("print").ToolTipText = "Ctrl+p"
        
        .Buttons("preview").Caption = "預覽"
        .Buttons("preview").Image = "preview"
        .Buttons("preview").ToolTipText = "Alt+V"
        
        .Buttons("output").Caption = "輸出"
        .Buttons("output").Image = "output"
        .Buttons("output").ToolTipText = "Ctrl+O"
        
        .Buttons("cmdyulan").Caption = "升級"
        .Buttons("cmdyulan").Image = "cmdyulan"
        .Buttons("cmdyulan").ToolTipText = "F5"
        
        .Buttons("search").Caption = "查詢"
        .Buttons("search").Image = "search"
        .Buttons("search").ToolTipText = "F3"
        
        .Buttons("save").Caption = "保存"
        .Buttons("save").Image = "save"
        .Buttons("save").ToolTipText = "F6"
        
        .Buttons("cancel").Caption = "放棄"
        .Buttons("cancel").Image = "cancel"
        '.Buttons("cancel").ToolTipText = "F4"
        .Buttons("cancel").ToolTipText = "Ctrl+Z"
        
        .Buttons("help").Caption = "幫助"
        .Buttons("help").Image = "help"
        .Buttons("help").ToolTipText = "F1"
        
        .Buttons("exit").Caption = "退出"
        .Buttons("exit").Image = "exit"
        .Buttons("exit").ToolTipText = "Ctrl+F4"
    End With
End Sub

Private Sub checkDup(ByVal R As Long, ByVal C As Long)
    Dim i As Integer
    selrow = R
    selcol = C
    
    With SuperGrid1
        For i = R - 1 To 1 Step -1
            If Trim(.TextMatrix(i, 0)) = Trim(.TextMatrix(R, 1)) Then
                MsgBox "第" & R & "行新賬戶號與第" & i & "行老賬戶號相同！請重新輸入！", vbInformation, "輸入錯誤！"
                errorNUm1 = 1
                error_Edit = True
                Exit Sub
            End If
            If Trim(.TextMatrix(i, 1)) = Trim(.TextMatrix(R, 1)) Then
                MsgBox "第" & R & "行新賬戶號與第" & i & "行新賬戶號相同！請重新輸入！", vbInformation, "輸入錯誤！"
                errorNUm1 = 1
                error_Edit = True
                .row = R
                .col = C
                .SetFocus
                Exit Sub
            End If
        Next
        For i = R + 1 To .Rows - 1
            If Trim(.TextMatrix(i, 0)) = Trim(.TextMatrix(R, 1)) Then
                MsgBox "第" & R & "行新賬戶號與第" & i & "行老賬戶號相同！請重新輸入！", vbInformation, "輸入錯誤！"
                errorNUm1 = 1
                error_Edit = True
                Exit Sub
            End If
            If Trim(.TextMatrix(i, 1)) = Trim(.TextMatrix(R, 1)) Then
                MsgBox "第" & R & "行新賬戶號與第" & i & "行新賬戶號相同！請重新輸入！", vbInformation, "輸入錯誤！"
                errorNUm1 = 1
                error_Edit = True
                Exit Sub
            End If
        Next
    End With
    errorNUm1 = 0
    error_Edit = False
End Sub
上一頁 1 2 34
?? 文件大小 979 K
?? 上傳用戶 apsdn
?? 所屬分類企業管理
??? 相關標簽

#visual #basic #財務 #源碼
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? frmaccupgrade.frm

?? 快捷鍵說明
