form1.frm

CELL组件的右键实例

VERSION 5.00
Object = "{7802D41A-28B0-43C4-95EA-17B7E32337D1}#1.0#0"; "CellCtrl5.ocx"
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   5835
   ClientLeft      =   150
   ClientTop       =   435
   ClientWidth     =   9390
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9.75
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5835
   ScaleWidth      =   9390
   StartUpPosition =   3  'Windows Default
   Begin CELL50Lib.Cell Cell1 
      Height          =   5550
      Left            =   0
      TabIndex        =   0
      Top             =   270
      Width           =   9375
      _Version        =   65536
      _ExtentX        =   16536
      _ExtentY        =   9790
      _StockProps     =   0
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "用鼠标右键点击 Cell 组件的不同部分，就会弹出不同的菜单"
      Height          =   195
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   5310
   End
   Begin VB.Menu mnuInCell 
      Caption         =   "单元格右键菜单"
      Visible         =   0   'False
      Begin VB.Menu mnuCut 
         Caption         =   "剪切(&T)"
      End
      Begin VB.Menu mnuCopy 
         Caption         =   "复制(&C)"
      End
      Begin VB.Menu mnuPaste 
         Caption         =   "粘贴(&P)"
      End
      Begin VB.Menu mnuSep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuInputFormula 
         Caption         =   "输入公式(&I)"
      End
      Begin VB.Menu mnuPainter 
         Caption         =   "格式刷(&M)"
      End
      Begin VB.Menu mnuClearCell 
         Caption         =   "清除单元格"
         Begin VB.Menu mnuClearContent 
            Caption         =   "清除内容(&N)"
            Shortcut        =   {DEL}
         End
         Begin VB.Menu mnuClearFormula 
            Caption         =   "清除公式(&L)"
         End
         Begin VB.Menu mnuClearAll 
            Caption         =   "清除全部(&A)"
         End
      End
      Begin VB.Menu mnuSep2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuCellProperty 
         Caption         =   "单元格格式(&C)..."
      End
      Begin VB.Menu mnuHyperlink 
         Caption         =   "超级链接(&H)..."
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Cell1_MenuCommand(ByVal col As Long, ByVal row As Long, ByVal itemid As Long)
    '单元格中的右键菜单
    With Cell1
        Select Case itemid
            Case 1001: mnuCut_Click            '剪切
            Case 1002: mnuCopy_Click           '复制
            Case 1003: mnuPaste_Click          '粘贴
            
            '行标菜单
            Case 1004: cmdInsertRow_click           '插入表行
            Case 1005: cmdDeleteRow_click           '删除行
            Case 1006: cmdAppendRow_click           '追加行
            Case 1007: cmdRowBestHeight_click       '最适合行高
            Case 1008: cmdRowHide_click             '隐藏行
            Case 1009: cmdRowUnhide_click           '取消隐藏行
            
            '列标菜单
            Case 1010: cmdInsertCol_click           '插入列
            Case 1011: cmdDeleteCol_click           '删除列
            Case 1012: cmdAppendCol_click           '追加列
            Case 1013: cmdColBestWidth_click        '最适合列宽
            Case 1014: cmdColHide_click             '隐藏列
            Case 1015: cmdColUnhide_click           '取消隐藏列
            
            '单击左上角弹出的菜单
            Case 1016: mnuClearContent_Click        '清除内容
            Case 1017: mnuClearFormula_Click        '清除公式
            Case 1018: mnuClearAll_Click            '清除全部
            Case 1019: mnuCellProperty_Click        '单元格属性
            
            '表页菜单
            Case 1020: .InsertSheet .GetCurSheet, 1     '插入表页
            Case 1021: .DeleteSheet .GetCurSheet, 1     '删除表页
            Case 1022: .InsertSheet .GetTotalSheets, 1  '追加表页
        End Select
    End With
    
    '鼠标在页签的操作按扭上的菜单
    For i = 1 To Cell1.GetTotalSheets
        If itemid = 1040 + i Then
            Cell1.SetCurSheet i - 1
            Exit For
        End If
    Next
End Sub
'*****************************************************************
'**********      表格中的右键菜单
'*****************************************************************
Private Sub Cell1_MenuStart(ByVal col As Long, ByVal row As Long, ByVal Section As Long)
With Cell1
    If Section = 1 Then '鼠标右键单击在表格区域内
        PopupMenu mnuInCell '弹出语言本身支持的右键菜单
    ElseIf Section = 2 Then '鼠标右键单击在行标上
        .AddPopMenu 1001, "剪切(&T)", 0
        .AddPopMenu 1002, "复制(&C)", 0
        .AddPopMenu 1003, "粘贴(&P)", 0
        .AddPopMenu 1000, "", 0
        .AddPopMenu 1004, "插入表行(&I)", 0
        .AddPopMenu 1005, "删除表行(&D)", 0
        .AddPopMenu 1006, "追加表行(&A)", 0
        .AddPopMenu 1000, "", 0
        .AddPopMenu 1007, "最适合行高(&B)", 0
        .AddPopMenu 1008, "隐藏(&N)", 0
        .AddPopMenu 1009, "取消隐藏(&U)", 0
    ElseIf Section = 3 Then '鼠标右键单击在列标上
        .AddPopMenu 1001, "剪切(&T)", 0
        .AddPopMenu 1002, "复制(&C)", 0
        .AddPopMenu 1003, "粘贴(&P)", 0
        .AddPopMenu 1000, "", 0
        .AddPopMenu 1010, "插入表列(&I)", 0
        .AddPopMenu 1011, "删除表列(&D)", 0
        .AddPopMenu 1012, "追加表列(&A)", 0
        .AddPopMenu 1000, "", 0
        .AddPopMenu 1013, "最适合列宽(&W)", 0
        .AddPopMenu 1014, "隐藏(&N)", 0
        .AddPopMenu 1015, "取消隐藏(&U)", 0
    ElseIf Section = 4 Then '鼠标右键单击在左上角
        .AddPopMenu 1001, "剪切(&T)", 0
        .AddPopMenu 1002, "复制(&C)", 0
        .AddPopMenu 1003, "粘贴(&P)", 0
        .AddPopMenu 1000, "", 0
        .AddPopMenu 1016, "清除内容(&N)     Del", 0
        .AddPopMenu 1017, "清除公式(&L)", 0
        .AddPopMenu 1018, "清除全部(&A)", 0
        .AddPopMenu 1000, "", 0
        .AddPopMenu 1019, "单元格格式(&C)...", 0
    ElseIf Section = 5 Then '鼠标右键单击在页签上
        .AddPopMenu 1020, "插入表页(&I)...", 0
        .AddPopMenu 1021, "删除表页(&D)...", 0
        .AddPopMenu 1022, "追加表页(&A)...", 0
    ElseIf Section = 6 Then '鼠标右键单击在页签的操作按扭上时
        CurSheet = .GetCurSheet
        TotalSheets = .GetTotalSheets
        For i = 1 To TotalSheets
            If i - 1 = CurSheet Then
                .AddPopMenu 1040 + i, .GetSheetLabel(i - 1), 8
            Else
                .AddPopMenu 1040 + i, .GetSheetLabel(i - 1), 0
            End If
        Next
    End If
End With
End Sub
'插入表行
Private Sub cmdInsertRow_click()
    Dim Startcol As Long, Startrow As Long, Endcol As Long, Endrow As Long
    With Cell1
        Startcol = 0: Startrow = 0: Endcol = 0: Endrow = 0
        .GetSelectRange Startcol, Startrow, Endcol, Endrow
        .InsertRow Startrow, Endrow - Startrow + 1, .GetCurSheet
    End With
End Sub
'删除表行
Private Sub cmdDeleteRow_click()
    Dim Startcol As Long, Startrow As Long, Endcol As Long, Endrow As Long
    With Cell1
        Startcol = 0: Startrow = 0: Endcol = 0: Endrow = 0
        .GetSelectRange Startcol, Startrow, Endcol, Endrow
        .DeleteRow Startrow, Endrow - Startrow + 1, .GetCurSheet
    End With
End Sub
'追加表行
Private Sub cmdAppendRow_click()
    Dim Startcol As Long, Startrow As Long, Endcol As Long, Endrow As Long
    With Cell1
        Startcol = 0: Startrow = 0: Endcol = 0: Endrow = 0
        .GetSelectRange Startcol, Startrow, Endcol, Endrow
        .InsertRow .GetRows(.GetCurSheet), Endrow - Startrow + 1, .GetCurSheet
    End With
End Sub
'最合适行高
Private Sub cmdRowBestHeight_click()
    Dim Startcol As Long, Startrow As Long, Endcol As Long, Endrow As Long
    With Cell1
        CurSheet = .GetCurSheet
        .GetSelectRange Startcol, Startrow, Endcol, Endrow
        For i = Startrow To Endrow
            BestHeight = .GetRowBestHeight(i)
            If BestHeight <> 0 Then
                .SetRowHeight 1, BestHeight, i, CurSheet
            End If
        Next
        .Invalidate
    End With
End Sub
'隐藏表行
Private Sub cmdRowHide_click()
    Dim Startcol As Long, Startrow As Long, Endcol As Long, Endrow As Long
    Cell1.GetSelectRange Startcol, Startrow, Endcol, Endrow
    Cell1.SetRowHidden Startrow, Endrow
End Sub
'取消隐藏表行
Private Sub cmdRowUnhide_click()
    Dim Startcol As Long, Startrow As Long, Endcol As Long, Endrow As Long
    Cell1.GetSelectRange Startcol, Startrow, Endcol, Endrow
    Cell1.SetRowUnhidden Startrow, Endrow
End Sub
'插入表列
Private Sub cmdInsertCol_click()
    Dim Startcol As Long, Startrow As Long, Endcol As Long, Endrow As Long
    With Cell1
        Startcol = 0: Startrow = 0: Endcol = 0: Endrow = 0
        .GetSelectRange Startcol, Startrow, Endcol, Endrow
        .InsertCol Startcol, Endcol - Startcol + 1, .GetCurSheet
    End With
End Sub
'删除表列
Private Sub cmdDeleteCol_click()
    Dim Startcol As Long, Startrow As Long, Endcol As Long, Endrow As Long
    With Cell1
        Startcol = 0: Startrow = 0: Endcol = 0: Endrow = 0
        .GetSelectRange Startcol, Startrow, Endcol, Endrow
        .DeleteCol Startcol, Endcol - Startcol + 1, .GetCurSheet
    End With
End Sub
'追加表列
Private Sub cmdAppendCol_click()
    Dim Startcol As Long, Startrow As Long, Endcol As Long, Endrow As Long
    With Cell1
        Startcol = 0: Startrow = 0: Endcol = 0: Endrow = 0
        .GetSelectRange Startcol, Startrow, Endcol, Endrow
        .InsertCol .GetCols(.GetCurSheet), Endcol - Startcol + 1, .GetCurSheet
    End With
End Sub
'最适合列宽
Private Sub cmdColBestWidth_click()
    Dim Startcol As Long, Startrow As Long, Endcol As Long, Endrow As Long
    With Cell1
        CurSheet = .GetCurSheet
        .GetSelectRange Startcol, Startrow, Endcol, Endrow
        For i = Startcol To Endcol
            BestWidth = .GetColBestWidth(i)
            If BestWidth <> 0 Then
                .SetColWidth 1, BestWidth, i, .GetCurSheet
                .Invalidate
            End If
        Next
    End With
End Sub
'隐藏表列
Private Sub cmdColHide_click()
    Dim Startcol As Long, Startrow As Long, Endcol As Long, Endrow As Long
    Cell1.GetSelectRange Startcol, Startrow, Endcol, Endrow
    Cell1.SetColHidden Startcol, Endcol
End Sub
'取消隐藏表列
Private Sub cmdColUnhide_click()
    Dim Startcol As Long, Startrow As Long, Endcol As Long, Endrow As Long
    Cell1.GetSelectRange Startcol, Startrow, Endcol, Endrow
    Cell1.SetColUnhidden Startcol, Endcol
End Sub

'单元格属性对话框
Private Sub mnuCellProperty_Click()
    Cell1.CellPropertyDlg
End Sub
'清楚全部
Private Sub mnuClearAll_Click()
    Cell1.Clear 32
End Sub
'清除文本
Private Sub mnuClearContent_Click()
    Cell1.Clear 1
End Sub
'清除公式
Private Sub mnuClearFormula_Click()
    Cell1.Clear 2
End Sub
'复制
Private Sub mnuCopy_Click()
    Dim Startcol As Long, Startrow As Long, Endcol As Long, Endrow As Long
    Cell1.GetSelectRange Startcol, Startrow, Endcol, Endrow
    
    Cell1.CopyRange Startcol, Startrow, Endcol, Endrow
End Sub
'剪切
Private Sub mnuCut_Click()
    Dim Startcol As Long, Startrow As Long, Endcol As Long, Endrow As Long
    Cell1.GetSelectRange Startcol, Startrow, Endcol, Endrow
    
    Cell1.CutRange Startcol, Startrow, Endcol, Endrow
End Sub
'超级链接对话框
Private Sub mnuHyperlink_Click()
    Cell1.HyperlinkDlg
End Sub
'输入公式
Private Sub mnuInputFormula_Click()
    Cell1.FormulaWizard Cell1.GetCurrentCol, Cell1.GetCurrentRow
End Sub
'格式刷
Private Sub mnuPainter_Click()
    Cell1.FormatPainter
End Sub
'粘贴
Private Sub mnuPaste_Click()
    Cell1.Paste Cell1.GetCurrentCol, Cell1.GetCurrentRow, 0, False, False
End Sub