form2.frm

本系统特为行业报价、订单、产品管理与客户关系管理所订制

 .Range(.Rows - 1, 1, .Rows - 1, 6).Borders(cellEdgeBottom) = cellDot
 .Range(.Rows - 1, 1, .Rows - 1, 6).Borders(cellEdgeTop) = cellDot
 .Range(.Rows - 1, 1, .Rows - 1, 6).Borders(cellEdgeLeft) = cellDot
 .Range(.Rows - 1, 1, .Rows - 1, 6).Borders(cellEdgeRight) = cellDot
 .Range(.Rows - 1, 1, .Rows - 1, 3).Alignment = cellLeftTop
 .Cell(.Rows - 1, 1).BackColor = StrBC
.RowHeight(.Rows - 1) = 40
 Grid_RC(4) = .Rows - 1 '损耗计算

.Rows = .Rows + 1
.Cell(.Rows - 1, 1).Text = "六、包装标准、包装物的供应与回收："
.Range(.Rows - 1, 1, .Rows - 1, 2).Merge
.Cell(.Rows - 1, 3).CellType = cellComboBox
.Range(.Rows - 1, 3, .Rows - 1, 6).Merge
.Range(.Rows - 1, 3, .Rows - 1, 6).Borders(cellEdgeBottom) = cellDot
.Cell(.Rows - 1, 3).BackColor = StrBC
.RowHeight(.Rows - 1) = 40
 Grid_RC(5) = .Rows - 1 '包装标准

.Rows = .Rows + 1
.Cell(.Rows - 1, 1).Text = "七、验收标准、方法及提出异议期限："
.Range(.Rows - 1, 1, .Rows - 1, 2).Merge
.Cell(.Rows - 1, 3).CellType = cellComboBox
.Range(.Rows - 1, 3, .Rows - 1, 6).Merge
.Range(.Rows - 1, 3, .Rows - 1, 6).Borders(cellEdgeBottom) = cellDot
.Cell(.Rows - 1, 3).BackColor = StrBC
.RowHeight(.Rows - 1) = 40
 Grid_RC(6) = .Rows - 1 '验收标准

.Rows = .Rows + 1
.Cell(.Rows - 1, 1).Text = "八、随机样品、配件数量及供应方法："
.Range(.Rows - 1, 1, .Rows - 1, 2).Merge
.Cell(.Rows - 1, 3).CellType = cellComboBox
.Range(.Rows - 1, 3, .Rows - 1, 6).Merge
.Range(.Rows - 1, 3, .Rows - 1, 6).Borders(cellEdgeBottom) = cellDot
.Cell(.Rows - 1, 3).BackColor = StrBC
.RowHeight(.Rows - 1) = 40
 Grid_RC(7) = .Rows - 1 '随机样品

.Rows = .Rows + 1
.Cell(.Rows - 1, 1).Text = "九、结算方式及期限："
.Range(.Rows - 1, 1, .Rows - 1, 2).Merge
.Cell(.Rows - 1, 3).CellType = cellComboBox
.Range(.Rows - 1, 3, .Rows - 1, 6).Merge
.Range(.Rows - 1, 3, .Rows - 1, 6).Borders(cellEdgeBottom) = cellDot
.Cell(.Rows - 1, 3).BackColor = StrBC
.RowHeight(.Rows - 1) = 25
 Grid_RC(8) = .Rows - 1 '质量要求
.Rows = .Rows + 1
.Range(.Rows - 1, 1, .Rows - 1, .Cols - 2).Merge
.Cell(.Rows - 1, 1).Text = "十、违约责任：按《中华人民共和国合同法》相关条款执行;"
.RowHeight(.Rows - 1) = 25
.Rows = .Rows + 1
.Range(.Rows - 1, 1, .Rows - 1, .Cols - 2).Merge
.Cell(.Rows - 1, 1).Text = "十一、本合同在履行过程中发生争议，由当事人双方友好协商解决;"
.RowHeight(.Rows - 1) = 25
.Rows = .Rows + 1
.Range(.Rows - 1, 1, .Rows - 1, .Cols - 2).Merge
.Cell(.Rows - 1, 1).Text = "十二、其它约定事项：建立在前述各项有效的基础上;"
.RowHeight(.Rows - 1) = 25
.Rows = .Rows + 1
.Range(.Rows - 1, 1, .Rows - 1, .Cols - 2).Merge
.Cell(.Rows - 1, 1).Text = "十三、本合同一式两份，传真件同样有效。"
.RowHeight(.Rows - 1) = 25
.Rows = .Rows + 1
.Range(.Rows - 1, 1, .Rows - 1, 3).Merge
.Range(.Rows - 1, 4, .Rows - 1, 6).Merge
 Set Qy1 = cnn.Execute("select * from zhmessage where yngf='1'")
 If Qy1.EOF = False Then
  .Cell(.Rows - 1, 1).Text = "                            供          方        " & vbCrLf & vbCrLf & "单位名称：" & Qy1.Fields(0) & vbCrLf & "地址：" & Qy1.Fields(1) & vbCrLf & "企业法人：" & Qy1.Fields(2) & vbCrLf & "业务代理：" & Qy1.Fields(3) & vbCrLf & _
  "开户行：" & Qy1.Fields(4) & vbCrLf & "帐号：" & Qy1.Fields(5) & vbCrLf & "电话：" & Qy1.Fields(6) & "     传真：" & Qy1.Fields(7)
 End If
 Set Qy1 = cnn.Execute("select * from zhmessage where coname='" & .Cell(3, 2).Text & "'")
 If Qy1.EOF = False Then
  .Cell(.Rows - 1, 4).Text = "                    需         方        " & vbCrLf & vbCrLf & "单位名称：" & Qy1.Fields(0) & vbCrLf & "地址：" & Qy1.Fields(1) & vbCrLf & "企业法人：" & Qy1.Fields(2) & vbCrLf & "业务代理：" & Qy1.Fields(3) & vbCrLf & _
  "开户行：" & Qy1.Fields(4) & vbCrLf & "帐号：" & Qy1.Fields(5) & vbCrLf & "电话：" & Qy1.Fields(6) & "     传真：" & Qy1.Fields(7)
 End If
 .RowHeight(.Rows - 1) = 150
 .Rows = .Rows + 1
 .Range(.Rows - 1, 1, .Rows - 1, 6).Merge
 .Range(.Rows - 1, 1, .Rows - 1, 6).Alignment = cellRightCenter
 .Cell(.Rows - 1, 1).Text = "盖章有效"
 .RowHeight(.Rows - 1) = 25
.Range(1, 1, .Rows - 1, .Cols - 2).WrapText = True
.AutoRedraw = True
.Refresh
End With
End Sub
Private Sub DHNote()

End Sub

Private Sub Grid1_CellChange(ByVal Row As Long, ByVal Col As Long)
If Row = 3 And Col = 2 Then
 If Grid1.Cell(Row, Col).Text <> "" And Grid_RC(2) <> 0 Then
  Set Qy3 = cnn.Execute("select shdz from c_message where coname='" & Grid1.Cell(Row, Col).Text & "'")
  If Qy3.EOF = False Then
   Grid1.Cell(Grid_RC(2), 3).Text = Qy3.Fields(0)
  End If
 End If
End If
End Sub

Private Sub Grid1_ComboDropDown(ByVal Row As Long, ByVal Col As Long)
On Error GoTo finish:
If Row = 3 And Col = 2 Then
 Set Qy1 = cnn.Execute("select coname from c_message")
 Do While Not Qy1.EOF
 Grid1.ComboBox(0).AddItem Qy1.Fields(0)
 Qy1.MoveNext
 Loop
End If
If Row = 2 And Col = 2 Then
 Set Qy1 = cnn.Execute("select ly from unit where numberid='16'")
 Do While Not Qy1.EOF
 Grid1.ComboBox(0).AddItem Qy1.Fields(0)
 Qy1.MoveNext
 Loop
End If
If Row = 3 And Col = 6 Then
 Set Qy1 = cnn.Execute("select ly from unit where numberid='7'")
 Do While Not Qy1.EOF
 Grid1.ComboBox(0).AddItem Qy1.Fields(0)
 Qy1.MoveNext
 Loop
End If
If Row = Grid_RC(0) And Col = 1 Then
 Set Qy1 = cnn.Execute("select ly from unit where numberid='8'")
 Do While Not Qy1.EOF
 Grid1.ComboBox(0).AddItem Qy1.Fields(0)
 Qy1.MoveNext
 Loop
End If
If Row = Grid_RC(1) And Col = 5 Then
 Set Qy1 = cnn.Execute("select ly from unit where numberid='9'")
 Do While Not Qy1.EOF
 Grid1.ComboBox(0).AddItem Qy1.Fields(0)
 Qy1.MoveNext
 Loop
End If
If Row = Grid_RC(3) And Col = 3 Then
 Set Qy1 = cnn.Execute("select ly from unit where numberid='10'")
 Do While Not Qy1.EOF
 Grid1.ComboBox(0).AddItem Qy1.Fields(0)
 Qy1.MoveNext
 Loop
End If
If Row = Grid_RC(4) And Col = 1 Then
 Set Qy1 = cnn.Execute("select ly from unit where numberid='11'")
 Do While Not Qy1.EOF
 Grid1.ComboBox(0).AddItem Qy1.Fields(0)
 Qy1.MoveNext
 Loop
End If
If Row = Grid_RC(5) And Col = 3 Then
 Set Qy1 = cnn.Execute("select ly from unit where numberid='12'")
 Do While Not Qy1.EOF
 Grid1.ComboBox(0).AddItem Qy1.Fields(0)
 Qy1.MoveNext
 Loop
End If
If Row = Grid_RC(6) And Col = 3 Then
 Set Qy1 = cnn.Execute("select ly from unit where numberid='13'")
 Do While Not Qy1.EOF
 Grid1.ComboBox(0).AddItem Qy1.Fields(0)
 Qy1.MoveNext
 Loop
End If
If Row = Grid_RC(7) And Col = 3 Then
 Set Qy1 = cnn.Execute("select ly from unit where numberid='14'")
 Do While Not Qy1.EOF
 Grid1.ComboBox(0).AddItem Qy1.Fields(0)
 Qy1.MoveNext
 Loop
End If
If Row = Grid_RC(8) And Col = 3 Then
 Set Qy1 = cnn.Execute("select ly from unit where numberid='15'")
 Do While Not Qy1.EOF
 Grid1.ComboBox(0).AddItem Qy1.Fields(0)
 Qy1.MoveNext
 Loop
End If
Exit Sub
finish:
End Sub

Private Sub Grid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
 PopupMenu Menu
End If
End Sub

Private Sub HTPrintSet_Click()
PrintS = "HT"
Printset.Caption = "合同打印设置"
Printset.Show 1
End Sub

Private Sub LoadXML_Click()
On Error GoTo finish:
If UKeyStr <> KeyStr And KeyStr <> "" Then
MsgBox "只有注册用户才可使用!", vbInformation, "提示"
Exit Sub
End If
OpenDialog.Filter = "合同文件(*.HT)|*.HT"
OpenDialog.ShowOpen
If OpenDialog.FileName <> "" And OpenDialog.CancelError = False Then
Grid1.LoadFromXML (OpenDialog.FileName)
MsgBox "文件(" & OpenDialog.FileName & ")已成功导入!", vbInformation, "提示"
End If
Exit Sub
finish:

End Sub

Private Sub PrintZ_Click()
On Error GoTo finish
  If UKeyStr <> KeyStr And KeyStr <> "" Then
  MsgBox "只有注册用户才可使用!", vbInformation, "提示"
  Exit Sub
  End If
   With Grid1.PageSetup
    '设置打印区域
    .PrintFixedRow = False '设定是否允许打印第0行
    .PrintFixedColumn = False '是否打印第0列
    .PrintRows = Grid1.Rows - 2 '需要打印的总行数
    .PrintColumns = Grid1.Cols - 3 '需要打印的总列数
    .PrintGridlines = True '是否显示中间的分隔线，即表格线
    .Orientation = cellPortrait '采用横幅打印还是竖行打印,竖行打印
    .PaperSize = cellPaperA4  'A4纸
    .CenterHorizontally = True  '打印内容水平居中
    .PrintFixedColumn = False
    .PrintFixedRow = False
    .PrintGridlines = False
    'Grid1.PrintDialog
    End With
    Set Qy3 = cnn.Execute("select * from pset where ss='HT'")
    If Qy3.EOF = False Then
    With Grid1.PageSetup
      '设置页眉
       If Qy3.Fields(0) = "1" Then
        .Header = Qy3.Fields(2)
        Select Case Qy3.Fields(7)
         Case "左侧"
           .HeaderAlignment = cellLeft
         Case "居中"
           .HeaderAlignment = cellCenter
         Case "右侧"
           .HeaderAlignment = cellRight
        End Select
        .HeaderFont.Name = "Times New Roman"
        .HeaderFont.Size = Qy3.Fields(3)
        .HeaderFont.Bold = Qy3.Fields(4)
        .HeaderFont.Italic = Qy3.Fields(5)
        .HeaderFont.Underline = Qy3.Fields(6)
       End If
       
       If Qy3.Fields(1) = "1" Then
        '设置页脚
        .Footer = Qy3.Fields(8)
        Select Case Qy3.Fields(10)
         Case "左侧"
           .FooterAlignment = cellLeft
         Case "居中"
           .FooterAlignment = cellCenter
         Case "右侧"
           .FooterAlignment = cellRight
        End Select
        .FooterFont.Name = "Verdana"
        .FooterFont.Size = Qy3.Fields(9)
       End If
       
       
        '设置页边距
        .LeftMargin = Qy3.Fields(11)
        .RightMargin = Qy3.Fields(12)
        .TopMargin = Qy3.Fields(13)
        .BottomMargin = Qy3.Fields(14)
        .HeaderMargin = Qy3.Fields(15)
        .FooterMargin = Qy3.Fields(16)
    End With
    End If
    Grid1.PrintPreview (Zoom) '打印预览
    Grid1.Refresh
    Exit Sub
finish:
    MsgBox Err.Description
End Sub

Private Sub SaveXML_Click()
On Error Resume Next
  If UKeyStr <> KeyStr And KeyStr <> "" Then
  MsgBox "只有注册用户才可使用!", vbInformation, "提示"
  Exit Sub
  End If
  OpenDialog.CancelError = True
  OpenDialog.DialogTitle = "导出文件"
  OpenDialog.FileName = ""
  OpenDialog.Filter = "导出合同文件(*.HT)|*.HT"
  OpenDialog.Flags = cdlOFNCreatePrompt + cdlOFNHideReadOnly
  OpenDialog.ShowSave
  If Err = cdlCancel Then Exit Sub
  Grid1.ExportToXML (OpenDialog.FileName)
  MsgBox "保存成功!路径(" & OpenDialog.FileName & ")", vbInformation, "提示"
End Sub

Private Sub SBG_Click()
If SBG.Checked = True Then
 SBG.Checked = False
 Grid1.Range(1, 1, Grid1.Rows - 1, Grid1.Cols - 1).BackColor = vbWhite
End If
End Sub