第一个窗体
Dim WithEvents adoPrimaryRS As Recordset
Dim mbChangedByCode As Boolean
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean
Dim mbDataChanged As BooleanPrivate Sub Command1_Click()
ddd.Show
End SubPrivate Sub Form_Load()
  Dim db As Connection
  Set db = New Connection
  db.CursorLocation = adUseClient
  db.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=E:\我的文档\数据库.mdb;"  Set adoPrimaryRS = New Recordset
  adoPrimaryRS.Open "select 品名,规格,单位,单价 from 发行赠品", db, adOpenStatic, adLockOptimistic  Dim oText As TextBox
  '绑定文本框到数据提供者
  For Each oText In Me.txtFields
    Set oText.DataSource = adoPrimaryRS
  Next  mbDataChanged = False
End SubPrivate Sub Form_Resize()
  On Error Resume Next
  lblStatus.Width = Me.Width - 1500
  cmdNext.Left = lblStatus.Width + 700
  cmdLast.Left = cmdNext.Left + 340
End SubPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  If mbEditFlag Or mbAddNewFlag Then Exit Sub  Select Case KeyCode
    Case vbKeyEscape
      cmdClose_Click
    Case vbKeyEnd
      cmdLast_Click
    Case vbKeyHome
      cmdFirst_Click
    Case vbKeyUp, vbKeyPageUp
      If Shift = vbCtrlMask Then
        cmdFirst_Click
      Else
        cmdPrevious_Click
      End If
    Case vbKeyDown, vbKeyPageDown
      If Shift = vbCtrlMask Then
        cmdLast_Click
      Else
        cmdNext_Click
      End If
  End Select
End SubPrivate Sub Form_Unload(Cancel As Integer)
  Screen.MousePointer = vbDefault
End SubPrivate Sub adoPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
  '为这个 recordset 显示当前记录位置
  lblStatus.Caption = "Record: " & CStr(adoPrimaryRS.AbsolutePosition)
End SubPrivate Sub adoPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
  '验证代码置于此处
  '下列动作发生时该事件被调用
  Dim bCancel As Boolean  Select Case adReason
  Case adRsnAddNew
  Case adRsnClose
  Case adRsnDelete
  Case adRsnFirstChange
  Case adRsnMove
  Case adRsnRequery
  Case adRsnResynch
  Case adRsnUndoAddNew
  Case adRsnUndoDelete
  Case adRsnUndoUpdate
  Case adRsnUpdate
  End Select  If bCancel Then adStatus = adStatusCancel
End SubPrivate Sub cmdAdd_Click()
  On Error GoTo AddErr
  With adoPrimaryRS
    If Not (.BOF And .EOF) Then
      mvBookMark = .Book
    End If
    .AddNew
    lblStatus.Caption = "添加记录"
    mbAddNewFlag = True
    SetButtons False
  End With  Exit Sub
AddErr:
  MsgBox Err.Description
End SubPrivate Sub cmdDelete_Click()
  On Error GoTo DeleteErr
  With adoPrimaryRS
    .Delete
    .MoveNext
    If .EOF Then .MoveLast
  End With
  Exit Sub
DeleteErr:
  MsgBox Err.Description
End SubPrivate Sub cmdRefresh_Click()
  '只有多用户应用程序需要
  On Error GoTo RefreshErr
  adoPrimaryRS.Requery
  Exit Sub
RefreshErr:
  MsgBox Err.Description
End SubPrivate Sub cmdEdit_Click()
  On Error GoTo EditErr  lblStatus.Caption = "编辑记录"
  mbEditFlag = True
  SetButtons False
  Exit SubEditErr:
  MsgBox Err.Description
End Sub
Private Sub cmdCancel_Click()
  On Error Resume Next  SetButtons True
  mbEditFlag = False
  mbAddNewFlag = False
  adoPrimaryRS.CancelUpdate
  If mvBookMark > 0 Then
    adoPrimaryRS.Book = mvBookMark
  Else
    adoPrimaryRS.MoveFirst
  End If
  mbDataChanged = FalseEnd SubPrivate Sub cmdUpdate_Click()
  On Error GoTo UpdateErr  adoPrimaryRS.UpdateBatch adAffectAll  If mbAddNewFlag Then
    adoPrimaryRS.MoveLast              '移到新记录
  End If  mbEditFlag = False
  mbAddNewFlag = False
  SetButtons True
  mbDataChanged = False  Exit Sub
UpdateErr:
  MsgBox Err.Description
End SubPrivate Sub cmdClose_Click()
  Unload Me
End SubPrivate Sub cmdFirst_Click()
  On Error GoTo GoFirstError  adoPrimaryRS.MoveFirst
  mbDataChanged = False  Exit SubGoFirstError:
  MsgBox Err.Description
End SubPrivate Sub cmdLast_Click()
  On Error GoTo GoLastError  adoPrimaryRS.MoveLast
  mbDataChanged = False  Exit SubGoLastError:
  MsgBox Err.Description
End SubPrivate Sub cmdNext_Click()
  On Error GoTo GoNextError  If Not adoPrimaryRS.EOF Then adoPrimaryRS.MoveNext
  If adoPrimaryRS.EOF And adoPrimaryRS.RecordCount > 0 Then
    Beep
     '已到最后返回
    adoPrimaryRS.MoveLast
  End If
  '显示当前记录
  mbDataChanged = False  Exit Sub
GoNextError:
  MsgBox Err.Description
End SubPrivate Sub cmdPrevious_Click()
  On Error GoTo GoPrevError  If Not adoPrimaryRS.BOF Then adoPrimaryRS.MovePrevious
  If adoPrimaryRS.BOF And adoPrimaryRS.RecordCount > 0 Then
    Beep
    '已到最后返回
    adoPrimaryRS.MoveFirst
  End If
  '显示当前记录
  mbDataChanged = False  Exit Sub
  
GoPrevError:
  MsgBox Err.Description
End SubPrivate Sub SetButtons(bVal As Boolean)
  cmdAdd.Visible = bVal
  cmdEdit.Visible = bVal
  cmdUpdate.Visible = Not bVal
  cmdCancel.Visible = Not bVal
  cmdDelete.Visible = bVal
  cmdClose.Visible = bVal
  cmdRefresh.Visible = bVal
  cmdNext.Enabled = bVal
  cmdFirst.Enabled = bVal
  cmdLast.Enabled = bVal
  cmdPrevious.Enabled = bVal
End SubPrivate Sub txtFields_Change(Index As Integer)
abc = txtFields(0).Text
End Sub

解决方案 »

  1.   

    第二个窗体
    Dim WithEvents adoPrimaryRS As Recordset
    Dim mbChangedByCode As Boolean
    Dim mvBookMark As Variant
    Dim mbEditFlag As Boolean
    Dim mbAddNewFlag As Boolean
    Dim mbDataChanged As BooleanPrivate Sub Form_Load()
      Dim db As Connection
      Set db = New Connection
      db.CursorLocation = adUseClient
      db.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=E:\我的文档\数据库.mdb;"  Set adoPrimaryRS = New Recordset
      adoPrimaryRS.Open "select 赠品名称,数量,单位,规格,出库日期,录入时间,收货站名 from 发行赠品出库表 where 赠品名称= " & abc, db, adOpenStatic, adLockOptimistic  Set grdDataGrid.DataSource = adoPrimaryRS
      mbDataChanged = False
    End SubPrivate Sub Form_Resize()
      On Error Resume Next
      '当窗体调整时会调整网格
      grdDataGrid.Height = Me.ScaleHeight - 30 - picButtons.Height - picStatBox.Height
      lblStatus.Width = Me.Width - 1500
      cmdNext.Left = lblStatus.Width + 700
      cmdLast.Left = cmdNext.Left + 340
    End SubPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
      If mbEditFlag Or mbAddNewFlag Then Exit Sub  Select Case KeyCode
        Case vbKeyEscape
          cmdClose_Click
        Case vbKeyEnd
          cmdLast_Click
        Case vbKeyHome
          cmdFirst_Click
        Case vbKeyUp, vbKeyPageUp
          If Shift = vbCtrlMask Then
            cmdFirst_Click
          Else
            cmdPrevious_Click
          End If
        Case vbKeyDown, vbKeyPageDown
          If Shift = vbCtrlMask Then
            cmdLast_Click
          Else
            cmdNext_Click
          End If
      End Select
    End SubPrivate Sub Form_Unload(Cancel As Integer)
      Screen.MousePointer = vbDefault
    End SubPrivate Sub adoPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
      '为这个 recordset 显示当前记录位置
      lblStatus.Caption = "Record: " & CStr(adoPrimaryRS.AbsolutePosition)
    End SubPrivate Sub adoPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
      '验证代码置于此处
      '下列动作发生时该事件被调用
      Dim bCancel As Boolean  Select Case adReason
      Case adRsnAddNew
      Case adRsnClose
      Case adRsnDelete
      Case adRsnFirstChange
      Case adRsnMove
      Case adRsnRequery
      Case adRsnResynch
      Case adRsnUndoAddNew
      Case adRsnUndoDelete
      Case adRsnUndoUpdate
      Case adRsnUpdate
      End Select  If bCancel Then adStatus = adStatusCancel
    End SubPrivate Sub cmdAdd_Click()
      On Error GoTo AddErr
      adoPrimaryRS.MoveLast
      adoPrimaryRS.AddNew
      grdDataGrid.SetFocus  Exit Sub
    AddErr:
      MsgBox Err.Description
    End SubPrivate Sub cmdDelete_Click()
      On Error GoTo DeleteErr
      With adoPrimaryRS
        .Delete
        .MoveNext
        If .EOF Then .MoveLast
      End With
      Exit Sub
    DeleteErr:
      MsgBox Err.Description
    End SubPrivate Sub cmdRefresh_Click()
      '只有多用户应用程序需要
      On Error GoTo RefreshErr
      Set grdDataGrid.DataSource = Nothing
      adoPrimaryRS.Requery
      Set grdDataGrid.DataSource = adoPrimaryRS  Exit Sub
    RefreshErr:
      MsgBox Err.Description
    End SubPrivate Sub cmdEdit_Click()
      On Error GoTo EditErr  lblStatus.Caption = "编辑记录"
      mbEditFlag = True
      SetButtons False
      Exit SubEditErr:
      MsgBox Err.Description
    End Sub
    Private Sub cmdCancel_Click()
      On Error Resume Next  SetButtons True
      mbEditFlag = False
      mbAddNewFlag = False
      adoPrimaryRS.CancelUpdate
      If mvBookMark > 0 Then
        adoPrimaryRS.Book = mvBookMark
      Else
        adoPrimaryRS.MoveFirst
      End If
      mbDataChanged = FalseEnd SubPrivate Sub cmdUpdate_Click()
      On Error GoTo UpdateErr  adoPrimaryRS.UpdateBatch adAffectAll  If mbAddNewFlag Then
        adoPrimaryRS.MoveLast              '移到新记录
      End If  mbEditFlag = False
      mbAddNewFlag = False
      SetButtons True
      mbDataChanged = False  Exit Sub
    UpdateErr:
      MsgBox Err.Description
    End SubPrivate Sub cmdClose_Click()
      Unload Me
    End SubPrivate Sub cmdFirst_Click()
      On Error GoTo GoFirstError  adoPrimaryRS.MoveFirst
      mbDataChanged = False  Exit SubGoFirstError:
      MsgBox Err.Description
    End SubPrivate Sub cmdLast_Click()
      On Error GoTo GoLastError  adoPrimaryRS.MoveLast
      mbDataChanged = False  Exit SubGoLastError:
      MsgBox Err.Description
    End SubPrivate Sub cmdNext_Click()
      On Error GoTo GoNextError  If Not adoPrimaryRS.EOF Then adoPrimaryRS.MoveNext
      If adoPrimaryRS.EOF And adoPrimaryRS.RecordCount > 0 Then
        Beep
         '已到最后返回
        adoPrimaryRS.MoveLast
      End If
      '显示当前记录
      mbDataChanged = False  Exit Sub
    GoNextError:
      MsgBox Err.Description
    End SubPrivate Sub cmdPrevious_Click()
      On Error GoTo GoPrevError  If Not adoPrimaryRS.BOF Then adoPrimaryRS.MovePrevious
      If adoPrimaryRS.BOF And adoPrimaryRS.RecordCount > 0 Then
        Beep
        '已到最后返回
        adoPrimaryRS.MoveFirst
      End If
      '显示当前记录
      mbDataChanged = False  Exit SubGoPrevError:
      MsgBox Err.Description
    End SubPrivate Sub SetButtons(bVal As Boolean)
      cmdAdd.Visible = bVal
      cmdEdit.Visible = bVal
      cmdUpdate.Visible = Not bVal
      cmdCancel.Visible = Not bVal
      cmdDelete.Visible = bVal
      cmdClose.Visible = bVal
      cmdRefresh.Visible = bVal
      cmdNext.Enabled = bVal
      cmdFirst.Enabled = bVal
      cmdLast.Enabled = bVal
      cmdPrevious.Enabled = bVal
    End Sub
      

  2.   

    我要将第一个窗体上文本框的内容作为条件在第二个窗体的datagrid控件中显示出来(第一个窗体中用adodc控件和几个文本框控件邦定数据库中的表一,然后在窗体2中的datagrid控件中显示数据库表二中字段值与指定窗体1中某个文本框值一样的所有记录)