主菜单.frm

计算机CAD图纸管理和预览

        For n = 1 To mainGrid.Cols - 1
             
           mainGrid.TextMatrix(Pasterow, n) = mainGrid.TextMatrix(Copyrow, n)
           mainGrid.Col = n
           mainGrid.CellBackColor = &HFFFF&
    
        Next n
        Selectrow = Empty
        
     Case "modify"
       If Selectrow = Empty Then
         MsgBox "您尚未选择修改行", vbInformation, "提醒"
         Exit Sub
       End If
        modifymodel.Show

     Case "seekfor"
        seekformodel.Show
        
     Case "delete"
       If Selectrow = Empty Then
         MsgBox "您尚未选择删除行", vbInformation, "提醒"
         Exit Sub
       End If
       If Selectrow = Copyrow Then
         modelbar.Buttons("paste").Enabled = False
       End If
       mainGrid.RemoveItem (Selectrow)
       Selectrow = Empty
       
     Case "insert"
       If Selectrow = Empty Then
         MsgBox "您尚未选择插入行", vbInformation, "提醒"
         Exit Sub
       End If
       mainGrid.AddItem "", Selectrow  'Date, Insertrow
       For j = 1 To mainGrid.Cols - 1
           mainGrid.Col = j

           mainGrid.CellBackColor = &HFFFF&

       Next j
       Selectrow = Empty
      Case "save"
        Call savemodel
        Call modelshow
     
  End Select
End Sub
Private Sub savemodel()
  Dim M As Integer
  Dim rsmodelcode As New ADODB.Recordset
  Dim rsmodellist As New ADODB.Recordset
  Dim modelcode As String
  Dim sqlmodelread As String
  
  For M = 1 To mainGrid.Rows - 1
    modelcode = Trim(mainGrid.TextMatrix(M, 2))     '机型代号
    If modelcode <> Empty Then

           sqlmodelread = "SELECT * FROM 机型登记 where 机型代号= '" & modelcode & "' "
           Call rsmodelcode.open(sqlmodelread, cn, adOpenKeyset, adLockOptimistic, -1)
           If rsmodelcode.RecordCount = 0 Then  '是未加入的新机型代号,需添加
                 rsmodellist.LockType = adLockOptimistic
                 rsmodellist.CursorType = adOpenKeyset
                 rsmodellist.open "机型登记", cn, , , adCmdTable
                 rsmodellist.AddNew
                 rsmodellist.Fields("机型代号").Value = Trim(mainGrid.TextMatrix(M, 2))  '机型代号
                 rsmodellist.Fields("机型名称").Value = Trim(mainGrid.TextMatrix(M, 3))  '机型名称
                 rsmodellist.Fields("申请图号").Value = Trim(mainGrid.TextMatrix(M, 4))  '申请图号
                 rsmodellist.Fields("申请人").Value = Trim(mainGrid.TextMatrix(M, 5))    '申请人
                 rsmodellist.Fields("项目组员").Value = Trim(mainGrid.TextMatrix(M, 6))   '项目组员
                 rsmodellist.Fields("开发年月").Value = Trim(mainGrid.TextMatrix(M, 7)) '开发年月
                 rsmodellist.Fields("备注").Value = Trim(mainGrid.TextMatrix(M, 8))     '备注
                 rsmodellist.Update
                 rsmodellist.Close
                   
           Else                                '是已有旧机型代号,可能需要修改
                 rsmodelcode.Fields("机型名称").Value = Trim(mainGrid.TextMatrix(M, 3))    '机型名称
                 rsmodelcode.Fields("申请图号").Value = Trim(mainGrid.TextMatrix(M, 4))   '申请图号
                 rsmodelcode.Fields("申请人").Value = Trim(mainGrid.TextMatrix(M, 5))     '申请人
                 rsmodelcode.Fields("项目组员").Value = Trim(mainGrid.TextMatrix(M, 6))  '项目组员
                 rsmodelcode.Fields("开发年月").Value = Trim(mainGrid.TextMatrix(M, 7))  '开发年月
                 rsmodelcode.Fields("备注").Value = Trim(mainGrid.TextMatrix(M, 8))      '备注
                 rsmodelcode.Update
           
           End If
           rsmodelcode.Close

  End If
  
 Next M
 MsgBox "机型登记修改，保存成功！", vbInformation, "机型登记"
 modelbar.Buttons("save").Enabled = False

End Sub
Private Sub extendtable()
       
       Dim selectunit As String
       selectunit = Trim(mainGrid.TextMatrix(Selectrow, 2))
            
       If TableExists(selectunit, cn) = True Then
          sqlselectmodel = "SELECT * FROM [" & selectunit & "]"

       Else
          MsgBox selectunit & "机型尚未导入构成表!", vbInformation, "通知"
          Exit Sub
       End If
       modelbar.Visible = False
       mainbar.Visible = False
       tablebar.Visible = True
       tableinbar.Visible = False
       tablebar.Buttons("paste").Enabled = False
       Call rstable.open(sqlselectmodel, cn, adOpenKeyset, adLockOptimistic, -1)
       Set mainGrid.DataSource = rstable
       mainStatusBar.Panels(2).Text = selectunit + ",总数: " + Trim(rstable.RecordCount)
       Call unitlist.machineShowGrid(rstable, mainGrid)
       rstable.Close
       
End Sub
Private Sub modelshow()
   mainGrid.Enabled = True
   mainGrid.Visible = False
   tablebar.Visible = False
   tableinbar.Visible = False
   mainbar.Visible = False
   modelbar.Visible = True
   modelbar.Buttons("paste").Enabled = False
   modelbar.Buttons("save").Enabled = False
   Dim sqlmodel As String
   sqlmodel = "SELECT * FROM 机型登记"
 
   Call rsmodel.open(sqlmodel, cn, adOpenKeyset, adLockOptimistic, -1)
   mainStatusBar.Panels(2).Text = "机型登记" + ",总数: " + Trim(rsmodel.RecordCount)
   mainGrid.Visible = True
   Set mainGrid.DataSource = rsmodel
  
   Call modelShowGrid(rsmodel, mainGrid)
    
   rsmodel.Close

End Sub

Private Sub mainbar_ButtonClick(ByVal Button As MSComctlLib.Button)
     Select Case Button.Key
     Case "table"
       Call modelshow
       
     Case "dwgmanage"
      dwgmanager.Show
      
      
     Case "excelin"
      'Call excelinprogram
      
     Case "unitlist"
       unitlist.Show
       
     Case "supplier"
       mainGrid.Enabled = True
       mainGrid.Visible = True
       Call supplier_Click
     
     Case "seek"
      
     Case "exit"
       If MsgBox("您将要退出技术管理软件？", vbQuestion + vbYesNo, "提醒 " & loginuser) = vbYes Then
      
         Unload Me
       End If
     End Select



End Sub
Private Sub excelinprogram()
  Dim cnexcelin As New ADODB.Connection
  Dim rsexcelin As New ADODB.Recordset
  Dim rscoderead As New ADODB.Recordset
  Dim rssavelist As New ADODB.Recordset
  Dim M As Integer
     With cnexcelin
       .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                           "Persist Security Info=False;" & _
                           "Data Source=D:\物品.xls;" & _
                           "Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
       .open
    
  End With
         
  rsexcelin.open "select * from [sheet1$]", cnexcelin, adOpenKeyset, adLockOptimistic
  rsexcelin.MoveFirst
  For M = 1 To rsexcelin.RecordCount
    coderead = Trim(rsexcelin.Fields("物品番号").Value)
    
    If coderead <> Empty Then
           sqlcoderead = "SELECT * FROM 物品番号 where 物品番号= '" & coderead & "' "
           Call rscoderead.open(sqlcoderead, cn, adOpenKeyset, adLockOptimistic, -1)
           If rscoderead.RecordCount = 0 Then  '是未加入的新图面番号,需添加
                 rssavelist.LockType = adLockOptimistic
                 rssavelist.CursorType = adOpenKeyset
                 rssavelist.open "物品番号", cn, , , adCmdTable
                 rssavelist.AddNew
                 rssavelist.Fields("物品番号").Value = rsexcelin.Fields("物品番号").Value
                 rssavelist.Fields("图面番号").Value = rsexcelin.Fields("图面番号").Value
                 rssavelist.Fields("版本号").Value = rsexcelin.Fields("版本号").Value
                 rssavelist.Fields("物品名称").Value = rsexcelin.Fields("物品名称").Value
                 rssavelist.Fields("规格").Value = rsexcelin.Fields("规格").Value
                 rssavelist.Fields("单位").Value = rsexcelin.Fields("单位").Value
                 rssavelist.Fields("取引先代号").Value = rsexcelin.Fields("取引先代号").Value
                 rssavelist.Update
                 rssavelist.Close
                   
           Else                                '是已有旧图面代号,可能需要修改
           
                 rscoderead.Fields("图面番号").Value = rsexcelin.Fields("图面番号").Value
                 rscoderead.Fields("版本号").Value = rsexcelin.Fields("版本号").Value
                 rscoderead.Fields("物品名称").Value = rsexcelin.Fields("物品名称").Value
                 rscoderead.Fields("规格").Value = rsexcelin.Fields("规格").Value
                 rscoderead.Fields("单位").Value = rsexcelin.Fields("单位").Value
                 rscoderead.Fields("取引先代号").Value = rsexcelin.Fields("取引先代号").Value
                 rscoderead.Update
           
           End If
           
           rscoderead.Close
      End If
      rsexcelin.MoveNext
    Next M
    
End Sub
Private Sub modelfind_Click(index As Integer)
  seekformodel.Show
End Sub



Private Sub open_Click(index As Integer)
 CommonDialog1.Filter = "All Files ( * .* )|*.*|" _
                     & "EXCEL Files ( *.XLS)|*.XLS"
 CommonDialog1.FilterIndex = 2
 CommonDialog1.ShowSave
End Sub

Private Sub OUTPUT_Click()
 CommonDialog1.Filter = "All Files ( * .* )|*.*|" _
                     & "EXCEL Files ( *.XLS)|*.XLS"
 CommonDialog1.FilterIndex = 2
 CommonDialog1.ShowSave
End Sub

Private Sub partfind_Click()
  构成表查询.Show
  
End Sub

Private Sub partman_Click()
 部品管理.Show
End Sub

Private Sub print_Click(index As Integer)
 CommonDialog1.Copies = 1
 CommonDialog1.ShowPrinter

End Sub

Private Sub replace_Click(index As Integer)
    'Call the replace text function

End Sub

Private Sub resave_Click(index As Integer)
 CommonDialog1.Filter = "All Files ( * .* )|*.*|" _
                     & "EXCEL Files ( *.XLS)|*.XLS"
 CommonDialog1.FilterIndex = 2
 CommonDialog1.ShowSave
End Sub


Private Sub support_Click(index As Integer)
  CommonDialog1.ShowHelp
End Sub





Private Sub menubar_ButtonClick(ByVal Button As MSComctlLib.Button)
 
 Select Case Button.Key
 Case "new"
  
 Case "open"
  CommonDialog1.Filter = "All Files ( * .* )|*.*|" _
                     & "EXCEL Files ( *.XLS)|*.XLS"
  CommonDialog1.FilterIndex = 2

  CommonDialog1.ShowOpen

 Case "save"
  
 Case "print"

  ' Write here Print Code with Printer Object...
   CommonDialog1.Copies = 1
   CommonDialog1.ShowPrinter
 Case "cut"
 
 Case "insert"
 
 Case "delete"
 
 Case "find"
 
 Case "replace"
 
 Case "copy"
  
 Case "paste"
  
 Case "undo"
  
 Case "redo"
  
 Case "link"
 
 Case "break"
 
 Case "email"
 Case "user"
     If UserType = True Then
         adduser.Show
     Else
         MsgBox "您无权限添加新用户！"
     End If
   
 Case "key"
     If UserType = True Then
         changePass.Show
     Else
        MsgBox "您无权限修改密码！"
     End If
   
 Case "help"
  CommonDialog1.ShowHelp
 End Select
 
End Sub



Private Sub maingrid_SelChange()
   
   Selectrow = mainGrid.Row
   
End Sub



Private Sub modelgrid_SelChange()
   Call GetFlexGridFirstColValue(modelGrid, strEmpFirstFieldValue)        '从表格中提取机型登记的编号
   Call G