frmpffinish.frm

这个是VB环境开发的,我也是转载的把原来的Access数据库改成了SQl Server数据库.希望大家可以借鉴

         Height          =   270
         Left            =   4080
         TabIndex        =   9
         Top             =   600
         Width           =   1575
      End
      Begin VB.TextBox txttype 
         Appearance      =   0  'Flat
         Height          =   270
         Left            =   4080
         TabIndex        =   3
         Top             =   240
         Width           =   1575
      End
      Begin VB.TextBox txtS 
         Appearance      =   0  'Flat
         Height          =   270
         Left            =   1320
         TabIndex        =   2
         Top             =   600
         Width           =   1575
      End
      Begin VB.TextBox txtEname 
         Appearance      =   0  'Flat
         Height          =   270
         Left            =   1320
         TabIndex        =   1
         Top             =   240
         Width           =   1575
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   " 所需数量："
         Height          =   180
         Left            =   3000
         TabIndex        =   10
         Top             =   600
         Width           =   990
      End
      Begin VB.Label lbl2 
         BackStyle       =   0  'Transparent
         Caption         =   "元件名称："
         Height          =   255
         Left            =   360
         TabIndex        =   6
         Top             =   285
         Width           =   975
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "规  格："
         Height          =   180
         Left            =   360
         TabIndex        =   5
         Top             =   600
         Width           =   720
      End
      Begin VB.Label Lbl4 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "元件类型："
         Height          =   180
         Index           =   1
         Left            =   3120
         TabIndex        =   4
         Top             =   240
         Width           =   900
      End
   End
   Begin VB.Frame Frame1 
      Height          =   735
      Left            =   360
      TabIndex        =   12
      Top             =   0
      Width           =   8295
      Begin VB.CommandButton cmdadd 
         Appearance      =   0  'Flat
         Caption         =   "添加配件"
         Height          =   375
         Left            =   3120
         TabIndex        =   14
         Top             =   240
         Width           =   1095
      End
      Begin MSDataListLib.DataCombo dtcmbP 
         Height          =   330
         Left            =   1320
         TabIndex        =   15
         Top             =   240
         Width           =   1455
         _ExtentX        =   2566
         _ExtentY        =   582
         _Version        =   393216
         Appearance      =   0
         Text            =   ""
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "选择配置产品："
         Height          =   180
         Left            =   120
         TabIndex        =   13
         Top             =   240
         Width           =   1260
      End
   End
End
Attribute VB_Name = "frmPFfinish"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim RsP As New Recordset
Dim Str As String
Dim StrRS As String
Dim RsEle As New Recordset
Dim strcol(4) As String
Dim txtfilename As String

Private Sub CmdAdd_Click()
On Error GoTo l
   If dtcmbP.Text <> "" Then
     'RsEle.Open "select * from elestock", cn, adOpenKeyset, adLockBatchOptimistic
     'frmelement.InsertType = "FrmPFfinish"
     frmelement.Show
     adogrd.RecordSource = "SELECT id, ENAME as 元件名称," & StrRS & " as 所需量 ,ESTANDARD as 说明,ETYPE as  类型,EUNIT as 单位,estock as 库存 FROM ELESTOCK"
     adogrd.Refresh
     Set GRD.DataSource = adogrd
   Else
     MsgBox "  请先选择产品！ ", , ginfo
     Exit Sub
   End If
    Exit Sub
l:    MsgBox err.Description
End Sub


Private Sub Cmdopen_Click()
On Error GoTo gl
 
If dtcmbP.Text <> "" Then
   adogrd.RecordSource = "SELECT id, ENAME as 元件名称," & StrRS & " as 所需量 ,ETYPE as 类型,ESTANDARD as  说明,EUNIT as 单位,estock as 库存 FROM ELESTOCK"
   adogrd.Refresh
   dlg.InitDir = App.Path & "\data"
   dlg.ShowOpen
   txtfilename = dlg.Filename
   If txtfilename <> "" Then
     Screen.MousePointer = 11
      xlstomdb txtfilename, adogrd
      MsgBox "   数据导入成功！  ", , ginfo
      Screen.MousePointer = vbDefault
      dlg.Filename = ""
   End If
   dtcmbP_Click 0
Else
   MsgBox "   请选择产品名称！", , ginfo
End If
Screen.MousePointer = vbDefault
Exit Sub
gl: MsgBox err.Description
End Sub

Private Sub test(lStr As String)
    On Error GoTo suberror
    Dim col As Integer
    Dim i As Integer
    For i = 0 To 4
    col = InStr(lStr, vbTab)
    If col = 0 Then
         strcol(i) = Left(lStr, Len(lStr))
         Exit Sub
    Else
        strcol(i) = Left(lStr, col - 1)
        lStr = Right(lStr, Len(lStr) - col)
    End If
    Next
    Exit Sub
suberror:
    MsgBox "读取文件失败，请检查文件格式是否正确后，重试！", vbOKOnly, "抱歉"
    End
End Sub
Private Sub Command2_Click()
    Unload Me
End Sub





Private Sub dtcmbP_Click(Area As Integer)
    StrRS = dtcmbP.BoundText
    If StrRS <> "" Then
        adogrd.RecordSource = ""
        adogrd.RecordSource = "SELECT id, ENAME as 元件名称," & StrRS & " as 所需量 ,ESTANDARD as 说明,ETYPE as  类型,EUNIT as 单位,estock as 库存 FROM ELESTOCK where " & StrRS & ">0 order by " & StrRS & ""
        adogrd.Refresh
        Set GRD.DataSource = adogrd
    End If
End Sub

Private Sub dtcmbP_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

Private Sub Form_Load()
On Error GoTo errl
    frmPFfinish.Top = 0
    frmPFfinish.Left = 0
    RsP.Open "select * FROM prostock", cn, adOpenKeyset, adLockBatchOptimistic
    Set dtcmbP.RowSource = RsP
    dtcmbP.ListField = "pname"
    dtcmbP.BoundColumn = "pcom"
    adogrd.ConnectionString = "provider=microsoft.jet.oledb.4.0;data source=" & _
    App.Path & "\data\jxcdb.mdb;"
    adogrd.CursorLocation = adUseClient
    Exit Sub
errl:    MsgBox err.Description
End Sub



Private Sub Form_Unload(Cancel As Integer)
    RsP.Close
    Set RsEle = Nothing
    Set RsP = Nothing
End Sub



Private Sub GRD_AfterColEdit(ByVal ColIndex As Integer)
 On Error GoTo l
    adogrd.RecordSource = "SELECT id, ENAME as 元件名称," & StrRS & " as 所需量 ,ESTANDARD as 规格,ETYPE as  类型,EUNIT as 单位,Estock as 库存 FROM ELESTOCK order by 所需量"
    If GRD.Columns(2).Text <> "" And Val(GRD.Columns(2).Text) >= 0 Then
        adogrd.Recordset.Fields!所需量 = GRD.Columns(1).Text
        adogrd.Recordset.UpdateBatch adAffectCurrent
    End If
    Set GRD.DataSource = adogrd
   Exit Sub
l: MsgBox " 不能为空！  ", , ginfo
  End Sub