frmhb.frm

用于电子行业打印复杂报表格式和不干胶标签

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Begin VB.Form frmhb 
   Caption         =   "环标数据导入"
   ClientHeight    =   5400
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8985
   LinkTopic       =   "Form1"
   ScaleHeight     =   5400
   ScaleWidth      =   8985
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdimporthb 
      Caption         =   "数据导入"
      Height          =   345
      Left            =   2700
      TabIndex        =   5
      Top             =   4860
      Width           =   1125
   End
   Begin MSDataGridLib.DataGrid DataGrid1 
      Bindings        =   "frmhb.frx":0000
      Height          =   3915
      Left            =   510
      TabIndex        =   4
      Top             =   660
      Width           =   8055
      _ExtentX        =   14208
      _ExtentY        =   6906
      _Version        =   393216
      AllowUpdate     =   0   'False
      HeadLines       =   1
      RowHeight       =   15
      FormatLocked    =   -1  'True
      BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ColumnCount     =   2
      BeginProperty Column00 
         DataField       =   "型号规格"
         Caption         =   "型号规格"
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column01 
         DataField       =   "环标"
         Caption         =   "环标"
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      SplitCount      =   1
      BeginProperty Split0 
         BeginProperty Column00 
            ColumnWidth     =   4004.788
         EndProperty
         BeginProperty Column01 
            ColumnWidth     =   1365.165
         EndProperty
      EndProperty
   End
   Begin MSComDlg.CommonDialog cdimport 
      Left            =   7110
      Top             =   4860
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdexit 
      Caption         =   "退出"
      Height          =   345
      Left            =   5430
      TabIndex        =   3
      Top             =   4860
      Width           =   1125
   End
   Begin VB.CommandButton cmdsch 
      Caption         =   "查找"
      Height          =   345
      Left            =   4065
      TabIndex        =   2
      Top             =   4860
      Width           =   1125
   End
   Begin VB.CommandButton cmdimport 
      Caption         =   "数据导入"
      Height          =   345
      Left            =   7740
      TabIndex        =   1
      Top             =   4830
      Visible         =   0   'False
      Width           =   1125
   End
   Begin MSAdodcLib.Adodc Adodc1 
      Height          =   330
      Left            =   180
      Top             =   4980
      Visible         =   0   'False
      Width           =   1245
      _ExtentX        =   2196
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   1
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Adodc1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin VB.Label Label1 
      Caption         =   "　环标数据导入"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3480
      TabIndex        =   0
      Top             =   150
      Width           =   2085
   End
End
Attribute VB_Name = "frmhb"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rstemp As ADODB.Recordset
Private Sub cmdexit_Click()
  Unload Me
End Sub

Private Sub cmdimport_Click()
Dim vbExcel As Object
Dim sFile As String
Dim rectotal, i As Integer
Dim tablename As String
 On Error Resume Next
 
  tablename = "环标表"
  Call Delrecord(tablename)

  With cdimport
    .DialogTitle = "打开"
    .CancelError = False
    'ToDo: 设置 common dialog 控件的标志和属性
    .Filter = "EXCEL文件 (*.xls)|*.xls"
    .ShowOpen
    If Len(.FileName) = 0 Then
      Exit Sub
     Else
     sFile = .FileName
    End If
  End With
  
   '创建Excel对象
  Set vbExcel = GetObject(, "Excel.Application")
  If Err.Number <> 0 Then  '表示Excel没有运行
    Set vbExcel = CreateObject("Excel.Application")
  End If
  Err.Clear
  
 rectotal = 30000 '导入的数据记录数
 With vbExcel
    .Visible = False
    .ScreenUpdating = True
    .Workbooks.Open sFile
    With .Sheets(1)  '填写数据
      For i = 2 To rectotal
       If Trim(.cells(i, 1)) <> "" Then
         If Trim(.cells(i, 8)) <> "" Then
         
        '  Set rsTemp = New ADODB.Recordset   '判断数据是否已存在
        '  rsTemp.CursorType = adOpenKeyset
        '  rsTemp.CursorLocation = adUseClient
        '  rsTemp.LockType = adLockOptimistic
        '  rsTemp.Open "select * from 环标表 where 型号规格='" & Trim(.cells(i, 2)) & "'", cnSys
        '  If rsTemp.RecordCount > 0 Then
        '    MsgBox "该型号规格相关记录已存在，请认真检查!", 0 + 16, "提示窗"
        '    Exit Sub
        '  End If
          
           Adodc1.Recordset.AddNew
           Adodc1.Recordset("型号规格") = Trim(.cells(i, 2))
           Adodc1.Recordset("环标") = Trim(.cells(i, 8))
           Adodc1.Recordset.Update
          End If
        Else
         Set vbExcel = Nothing
         MsgBox "数据导入完毕！", 0 + 16, "提示窗"
         Exit Sub
       End If
      Next
    End With
  End With
  Set vbExcel = Nothing  'Release Excel Object variable
   MsgBox "数据导入完毕！", 0 + 16, "提示窗"
End Sub

Private Sub cmdimporthb_Click()
Dim tablename As String
 On Error Resume Next
  tablename = "环标表"
  Call Delrecord(tablename)
  
   rstemp.Close
   rstemp.Open "select * from 产品设计规范", cnSyshb
   rstemp.MoveFirst
   Do While Not rstemp.EOF
     Adodc1.Recordset.AddNew
     Adodc1.Recordset("型号规格") = Trim(rstemp("型号/规格"))
     Adodc1.Recordset("环标") = Trim(rstemp("环保标准"))
     Adodc1.Recordset.Update
     rstemp.MoveNext
   Loop
  MsgBox "数据导入完毕！", 0 + 16, "提示窗"
End Sub

Private Sub cmdsch_Click()
On Error Resume Next
  tabname = "环标表"
  If cmdsch.Caption = "查找" Then
    frmSearch.Show vbModal
    If strQuery <> "" Then
      Adodc1.RecordSource = strQuery
      Adodc1.Refresh
      cmdsch.Caption = "重置"
    End If
  Else
    strQuery = "Select * From " & tabname
    Adodc1.RecordSource = strQuery
    Adodc1.Refresh
    cmdsch.Caption = "查找"
  End If
End Sub

Private Sub Form_Load()
Dim hbtemp As String
On Error Resume Next

   hbtemp = "无"
   Set rstemp = New ADODB.Recordset   '初始化数据库
   rstemp.CursorType = adOpenKeyset
   rstemp.CursorLocation = adUseClient
   rstemp.LockType = adLockOptimistic
   rstemp.Open "select * from 产品设计规范 where 型号/规格='" & hbtemp & "'", cnSyshb

  Adodc1.ConnectionString = strConn
  Adodc1.RecordSource = "Select * From 环标表"
  Adodc1.Refresh
End Sub