Vb用户定义类型未定义,求救？ - VB6论坛

pgykcy

等　级：新手上路
帖　子：3
专家分：0
注　册：2008-7-11

楼主

问题点数：0 回复次数：7

Vb用户定义类型未定义,求救？

Private Sub tlbToolBar_ButtonClick(ByVal Button As ComctlLib.Button)

  On Error GoTo tlbToolBar_ButtonClickErr

  Select Case Button.Key
    Case "New"
      mnuDBNew_Click
    Case "Open"
      mnuDBOpen_Click
      Me.mnuOptPaint.Enabled = True
    Case "Close"
      mnuDBClose_Click
      Me.mnuOptPaint.Enabled = False '使绘制对比图按钮无效
    Case "Edit"
      mnuEdtEditer_Click
    Case "Delete"
      mnuEdtDelete_Click
    Case "Number"
      mnuEdtNumber_Click
  End Select

  Exit Sub

tlbToolBar_ButtonClickErr:
  ShowError

End Sub

搜索更多相关主题的帖子: Case　定义　 Click　类型　

2008-07-11 10:38

pgykcy

等　级：新手上路
帖　子：3
专家分：0
注　册：2008-7-11

第 3 楼

得分:0

回复 2# vbc 的帖子

Option Explicit
Option Compare Binary
'¹¤¾ßÌáÊ¾
Const TOOLTIP1 = "ÐÂ½¨Êý¾Ý¿â"
Const TOOLTIP2 = "´ò¿ªÊý¾Ý¿â"
Const TOOLTIP3 = "¹Ø±ÕÊý¾Ý¿â"
Const TOOLTIP4 = "´«µÝÀàÐÍ¼ÇÂ¼¼¯"
Const TOOLTIP5 = "ÔÚÐÂ´°ÌåÉÏÊ¹ÓÃ Data ¿Ø¼þ"
Const TOOLTIP6 = "ÔÚÐÂ´°ÌåÉÏ²»Ê¹ÓÃ Data ¿Ø¼þ"
Const TOOLTIP7 = "ÔÚÐÂ´°ÌåÉÏÊ¹ÓÃ DBGrid ¿Ø¼þ"
Const TOOLTIP8 = "¿ªÊ¼ÊÂÎñ"
Const TOOLTIP9 = "»Ø¹öµ±Ç°ÊÂÎñ"
Const TOOLTIP10 = "Ìá½»µ±Ç°ÊÂÎñ" '
'ÔÓÏî×Ö·û´®
Const MSG3 = "°´»Ø³µ¼ü¹Ø±Õ¡°¹ØÓÚ¡±¶Ô»°¿ò"   'ÔÎÄÓÐÎó
Const MSG4 = "ÊäÈëÐÂÊý¾Ý¿â²ÎÊý"
Const MSG5 = "ÊäÈë ODBCINST.INI ÎÄ¼þÖÐµÄÇý¶¯³ÌÐòÃû³Æ£º"
Const MSG6 = "Çý¶¯³ÌÐòÃû³Æ"
Const MSG7 = "±ØÐëÊ×ÏÈ¹Ø±Õ£¡"
Const MSG8 = "×¢Òâ£ºÍÆ¼öÊ¹ÓÃ¸½¼Ó±í"
Const MSG9 = "Microsoft Access MDB (*.mdb)|*.mdb|ËùÓÐÎÄ¼þ (*.*)|*.*"
Const MSG10 = "´ò¿ªÒªÐÞ¸´µÄ Microsoft Access Êý¾Ý¿â"
Const MSG11 = "ÕýÔÚÐÞ¸´"
Const MSG12 = "´ò¿ªÐÞ¸´µÄÊý¾Ý¿âÂð£¿"
Const MSG13 = "ÏµÍ³Êý¾Ý¿â|SYSTEM.MD?"
Const MSG14 = "Ñ¡Ôñ SYSTEM.MD? £¨Microsoft Access °²È«ÎÄ¼þ£©"
Const MSG15 = "ÓÃ»§£º"
Const MSG16 = "ÒòÎª´íÎó£¬±ØÐë¹Ø±Õµ±Ç°Êý¾Ý¿â£¡"
Const MSG17 = "Î´ÕÒµ½ÓÃ»§£¬ÊÔÒ»ÏÂ¡°ÊµÓÃ³ÌÐò/System MD?¡±£¡"
Const MSG18 = "µÇÂ¼³¬Ê±£¨Ãë£©£º"
Const MSG19 = "Ã»ÓÐ´ò¿ªµÄÊý¾Ý¿â"
Const MSG20 = "²éÑ¯³¬Ê±£¨Ãë£©£º"
Const MSG21 = "É¾³ý±íÂð£¿"
Const MSG22 = "É¾³ý²éÑ¯¶¨ÒåÂð£¿"
Const MSG23 = "É¾³ý×Ö¶ÎÂð£¿"
Const MSG24 = "É¾³ýË÷ÒýÂð£¿"
Const MSG25 = "É¾³ý±íÖÐËùÓÐ¼ÇÂ¼Âð£¿"
Const MSG26 = "É¾³ýµÄÐÐ£º"
Const MSG27 = "Î´ÕÒµ½ SYSTEM.MD?£¬ÔÚ VB ÉèÖÃÖµÖÐ¼ÓÈëÒ»¸öÂð£¿"
Const MSG28 = "Õâ¸öÇý¶¯³ÌÐò²»Ö§³ÖÊÂÎñ£¡"
Const MSG29 = "ËùÓÐ¸Ä±ä½«±»¶ªÊ§£¬»Ø¹öÂð£¿"
Const MSG30 = "ÊôÐÔÊÇÖ»¶ÁµÄ£¡"
Const MSG31 = "¸Ãº¯ÊýÐèÒªÒ»¸ö»î¶¯µÄ¹¤³Ì£¡"
Const MSG37 = "É¾³ý¼ÇÂ¼Âð£¿"
'>>>>>>>>>>>>>>>>>>>>>>>>

Dim mHwnd As Long
Private Sub mnuUSystemDB_Click()

  On Error Resume Next

  Dim sTmp As String
  Dim X As Integer

  With dlgCMD1
    .Filter = MSG13
    .DialogTitle = MSG14
    .FilterIndex = 1
    .FileName = "SYSTEM.MDW"
    .CancelError = True
    .Flags = FileOpenConstants.cdlOFNHideReadOnly + FileOpenConstants.cdlOFNFileMustExist
  End With
  On Error Resume Next
  dlgCMD1.ShowOpen
  If Err = 32755 Then         'ÓÃ»§È¡ÏûÁË
    Exit Sub
  Else
    sTmp = dlgCMD1.FileName  '±ØÐëÊÇÒ»¸öºÃµÄÎÄ¼þÃû
    SaveSetting APP_CATEGORY & "\Analysis", "Engines", "SystemDB", sTmp
    SaveSetting APP_CATEGORY, App.Title, "LoadSystemDB", "Yes"
  End If

End Sub

Private Sub MDIForm_Load()

  Dim X As Integer
  Screen.MousePointer = vbHourglass
  '¹¤¾ßÌáÊ¾
  tlbToolBar.Buttons(1).ToolTipText = TOOLTIP1
  tlbToolBar.Buttons(2).ToolTipText = TOOLTIP2
  tlbToolBar.Buttons(3).ToolTipText = TOOLTIP3
  mnuOptReadOnly.Checked = True
  gnReadOnly = True
  gnSelectRun = False

  mnuDBNew.Enabled = False
  mnuDBClose.Visible = False
  mnuDBBar0.Visible = False
  mnuEdit.Visible = False
  mnuOperate.Visible = False


  'È¡µÃ´°Ìå×ù±ê
  X = Val(GetINIString("WindowState", "2"))
  If X <> 1 Then
    frmMDI.WindowState = X
  Else
    frmMDI.WindowState = 0
  End If
  If frmMDI.WindowState = 0 Then
    frmMDI.Left = Val(GetINIString("WindowLeft", "0"))
    frmMDI.Top = Val(GetINIString("WindowTop", "0"))
    frmMDI.Width = Val(GetINIString("WindowWidth", "9135"))
    frmMDI.Height = Val(GetINIString("WindowHeight", "6900"))
  End If

  '¿´ÊÇ·ñÓÃ»§ÔÚÒÔÇ°»Ø´ð¡°Ìí¼Ó system.mda¡±Ê±Ëµ¡°²»¡±
  If Len(GetINIString("LoadSystemDB", vbNullString)) = 0 Then
    'µÚÒ»´Î£¬ËùÒÔÌáÊ¾Èç¹ûÃ»ÓÐ¾ÍÌí¼ÓËü
    If MsgBox("Ìí¼Ó SYSTEM.MD? (Microsoft Access °²È«ÎÄ¼þ) µ½ INI ÎÄ¼þÂð£¿", vbYesNo + vbQuestion) = vbYes Then
      mnuUSystemDB_Click
    Else
      '´æ´¢ÐÅÏ¢£¬¾Í²»ÓÃÔÙÎÊÁË
      SaveSetting APP_CATEGORY, App.Title, "LoadSystemDB", "No"
    End If
  End If

  On Error GoTo MDILErr

  'ÉèÖÃ DBEngine
  DBEngine.IniPath = "HKEY_CURRENT_USER\Software\VB and VBA Program Settings\" & APP_CATEGORY & "\" & App.Title
  DBEngine.DefaultUser = "admin"
  DBEngine.DefaultPassword = vbNullString

  'µÇÂ¼µ½ Jet
  On Error Resume Next
  Set gwsMainWS = DBEngine.CreateWorkspace("MainWS", "admin", vbNullString)
  On Error GoTo MDILErr

  'Ìí¼Ó¹¤×÷¿Õ¼äµ½¼¯ºÏÖÐ£¬Ôö¼ÓÆäÊýÁ¿
  Workspaces.Append gwsMainWS
  Me.Show
  LoadINISettings
  Screen.MousePointer = vbDefault
  Exit Sub

MDILErr:
  ShowError

End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)

  On Error Resume Next
  ShutDownAnalysis

  If mHwnd <> 0 Then
    'µ± VisData ´Ó VB µÄ¡°Íâ½Ó³ÌÐò¡±²Ëµ¥ÖÐ¼ÓÔØÊ±ÐèÒª
    mHwnd = SetWindowLong(Me.hwnd, -8, GetDesktopWindow())
  End If

End Sub

Private Sub mnuDBClose_Click()
  Me.mnuOptPaint.Enabled = False 'Ê¹»æÖÆ¶Ô±ÈÍ¼°´Å¥ÎÞÐ§
  mnuOptRelative.Enabled = False
  CloseCurrentDB
End Sub

Private Sub mnuDBExit_Click()

  Unload Me

End Sub

Private Sub mnuDBMRU_Click(Index As Integer)

  On Error GoTo MRUErr

  gsDBName = Mid(mnuDBMRU(Index).Caption, 4, Len(mnuDBMRU(Index).Caption))
  gsDataType = mnuDBMRU(Index).Tag
  OpenLocalDB 2
  Me.mnuOptPaint.Enabled = True
  Exit Sub
MRUErr:
  ShowError
End Sub

Private Sub mnuDBNew_Click()
  NewMDB dbVersion30
End Sub

Private Sub mnuDBOpen_Click()
  '´ò¿ªÊý¾ÝÎÄ¼þ
  gsDataType = gsMSACCESS
  OpenLocalDB 1
  Me.mnuOptPaint.Enabled = True
End Sub
Private Sub mnuDfilter_Click()

  Dim frm As New frmFilter
  frm.Show

End Sub

Private Sub mnuEdtDelete_Click()

  On Error GoTo RFErr

  If Not grstRecordset.EOF Then
    If MsgBox(MSG37, vbYesNo + vbQuestion) = vbYes Then
      grstRecordset.Delete
    End If
  End If
  Exit Sub

RFErr:
  ShowError

End Sub

Private Sub mnuEdtNumber_Click()

  On Error GoTo NMbErr

  Dim i As Integer

  grstRecordset.MoveFirst
  With grstRecordset.Fields(0)
    For i = 1 To grstRecordset.RecordCount
      grstRecordset.Edit
      .Value = i
      grstRecordset.Update
      grstRecordset.MoveNext
    Next i
  End With

  Exit Sub

NMbErr:
  ShowError
End Sub

Private Sub mnuEdtEditer_Click()

  On Error GoTo LoadErr

  Dim str As String
  Dim dbTemp As Database

  str = gsDBName
  CloseCurrentDB

  Set dbTemp = gwsMainWS.OpenDatabase(str, False, gnReadOnly, vbNullString)
  Set gdbCurrentDB = dbTemp
  gsDBName = str
  frmTblStruct.Show vbModal

  Exit Sub

LoadErr:
  ShowError
End Sub
Private Sub mnuHelpContents_Click()


    Dim nRet As Integer

    'Èç¹ûÕâ¸ö¹¤³ÌÃ»ÓÐ°ïÖúÎÄ¼þ£¬ÏÔÊ¾ÏûÏ¢¸øÓÃ»§
    '¿ÉÒÔÔÚ¡°¹¤³ÌÊôÐÔ¡±¶Ô»°¿òÖÐÎªÓ¦ÓÃ³ÌÐòÉèÖÃ°ïÖúÎÄ¼þ
    App.HelpFile = App.Path + "\" + "analysis.hlp"
    If Len(App.HelpFile) = 0 Then
        MsgBox "ÎÞ·¨ÏÔÊ¾°ïÖúÄ¿Â¼£¬¸Ã¹¤³ÌÃ»ÓÐÏà¹ØÁªµÄ°ïÖú¡£", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If
End Sub

Private Sub mnuHelpSearch_Click()
    Dim nRet As Integer
    App.HelpFile = App.Path + "\" + "analysis.hlp"
    'Èç¹ûÕâ¸ö¹¤³ÌÃ»ÓÐ°ïÖúÎÄ¼þ£¬ÏÔÊ¾ÏûÏ¢¸øÓÃ»§¿ÉÒÔÔÚ¡°¹¤³ÌÊôÐÔ¡±¶Ô»°¿òÖÐÎªÓ¦ÓÃ³ÌÐòÉèÖÃ°ïÖúÎÄ¼þ
    If Len(App.HelpFile) = 0 Then
        MsgBox "ÎÞ·¨ÏÔÊ¾°ïÖúÄ¿Â¼£¬¸Ã¹¤³ÌÃ»ÓÐÏà¹ØÁªµÄ°ïÖú¡£", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If
End Sub

Private Sub mnuHlpAbout_Click()
    frmAbout.Show 1
End Sub

Private Sub mnuOperStart_Click()
  Dim frm As New frmOperation
  If gnSelectRun Then frmSetRange.Show vbModal
  frm.Show
End Sub

Private Sub mnuOptDeterminer_Click()

  frmDeterminer.Show vbModal

End Sub

Private Sub mnuOptPaint_Click()
     optPaint.Show 1
End Sub

Private Sub mnuOptReadOnly_Click()

  If mnuOptReadOnly.Checked = True Then
    mnuOptReadOnly.Checked = False
    gnReadOnly = False
    mnuDBNew.Enabled = True
    tlbToolBar.Buttons("New").Enabled = True
    mnuEdit.Enabled = True
  Else
    mnuOptReadOnly.Checked = True
    gnReadOnly = True
    mnuDBNew.Enabled = False
    tlbToolBar.Buttons("New").Enabled = False
    mnuEdit.Enabled = False
  End If

End Sub

Private Sub mnuOptRelative_Click()
    ksqt.Show
End Sub

Private Sub mnuOptSelectRun_Click()
  If mnuOptSelectRun.Checked = True Then
    mnuOptSelectRun.Checked = False
    gnSelectRun = False
  Else
    mnuOptSelectRun.Checked = True
    gnSelectRun = True
  End If

End Sub

Private Sub mnuRC_Click()
  mnuOperStart.Enabled = True
  If relativeAlyasis = True Then
  mnuOptRelative.Enabled = True
  Else
  mnuOptRelative.Enabled = False
  End If
  frmRateCalcu.Show
End Sub

Private Sub Timer1_Timer()
  frmMDI.stsStatusBar.Panels(3).Text = Format$(Time, "  hh:mm:ss")
  frmMDI.stsStatusBar.Panels(1).Text = "°æÈ¨ËùÓÐ(C) 1999-2000"
End Sub

Private Sub tlbToolBar_ButtonClick(ByVal Button As Control)

  On Error GoTo tlbToolBar_ButtonClickErr

  Select Case Button.Key
    Case "New"
      mnuDBNew_Click
    Case "Open"
      mnuDBOpen_Click
      Me.mnuOptPaint.Enabled = True
    Case "Close"
      mnuDBClose_Click
      Me.mnuOptPaint.Enabled = False 'Ê¹»æÖÆ¶Ô±ÈÍ¼°´Å¥ÎÞÐ§
    Case "Edit"
      mnuEdtEditer_Click
    Case "Delete"
      mnuEdtDelete_Click
    Case "Number"
      mnuEdtNumber_Click
  End Select
  Exit Sub

tlbToolBar_ButtonClickErr:
  ShowError

End Sub

2008-07-11 11:14