excelgrid.ctl

来自「很好！ 很实用！ 免费！」· CTL 代码 · 共 258 行

VERSION 5.00
Object = "{0002E550-0000-0000-C000-000000000046}#1.0#0"; "OWC10.DLL"
Begin VB.UserControl ExcelGrid 
   ClientHeight    =   3405
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5040
   ScaleHeight     =   3405
   ScaleWidth      =   5040
   Begin OWC10.PivotTable PivotTable1 
      Height          =   2415
      Left            =   720
      OleObjectBlob   =   "ExcelGrid.ctx":0000
      TabIndex        =   0
      Top             =   720
      Width           =   3570
   End
End
Attribute VB_Name = "ExcelGrid"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit
Dim m_FieldName As String
Dim m_CaptionName As String
Dim m_DataRecordset As ADODB.Recordset '

'Event Declarations:
Event DblClick() 'MappingInfo=PivotTable1,PivotTable1,-1,DblClick
Event Click() 'MappingInfo=PivotTable1,PivotTable1,-1,Click
Event KeyDown(ByVal KeyCode As Long, ByVal Shift As Long) 'MappingInfo=PivotTable1,PivotTable1,-1,KeyDown
Event KeyUp(ByVal KeyCode As Long, ByVal Shift As Long) 'MappingInfo=PivotTable1,PivotTable1,-1,KeyUp
Event KeyPress(ByVal KeyAscii As Long) 'MappingInfo=PivotTable1,PivotTable1,-1,KeyPress

Public Sub RelativeGrid(ByRef p_Rs As ADODB.Recordset, Optional ByVal p_FieldName As String = "", Optional ByVal p_CaptionName As String = "")
Dim i As Integer
Dim p_ArrFieldName() As String
Dim p_ArrCaptionName() As String

    If p_FieldName > "" Then
        m_FieldName = p_FieldName
    End If
    If p_CaptionName > "" Then
        m_CaptionName = p_CaptionName
    End If

    p_ArrFieldName = Split(m_FieldName, ",")
    p_ArrCaptionName = Split(m_CaptionName, ",")

    Set PivotTable1.DataSource = p_Rs
    
    For i = 0 To UBound(p_ArrFieldName)
        PivotTable1.ActiveView.DataAxis.InsertFieldSet PivotTable1.ActiveView.FieldSets(Trim(p_ArrFieldName(i)))
        PivotTable1.ActiveView.DataAxis.FieldSets.Item(i).Fields.Item(0).Caption = Trim(p_ArrCaptionName(i))
    Next i
End Sub

Private Sub UserControl_Resize()
    PivotTable1.Left = 10
    PivotTable1.Top = 10
    PivotTable1.Width = UserControl.Width - 20
    PivotTable1.Height = UserControl.Height - 20
End Sub

Public Property Get DataRecordset() As Recordset
    Set DataRecordset = PivotTable1.ActiveData.Recordset
End Property
Private Sub PivotTable1_DblClick()
    RaiseEvent DblClick
End Sub

Private Sub PivotTable1_Click()
    RaiseEvent Click
End Sub

Private Sub PivotTable1_KeyDown(ByVal KeyCode As Long, ByVal Shift As Long)
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub PivotTable1_KeyUp(ByVal KeyCode As Long, ByVal Shift As Long)
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub PivotTable1_KeyPress(ByVal KeyAscii As Long)
    RaiseEvent KeyPress(KeyAscii)
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=PivotTable1,PivotTable1,-1,AllowFiltering
Public Property Get AllowFiltering() As Boolean
    AllowFiltering = PivotTable1.AllowFiltering
End Property

Public Property Let AllowFiltering(ByVal New_AllowFiltering As Boolean)
    PivotTable1.AllowFiltering() = New_AllowFiltering
    PropertyChanged "AllowFiltering"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=PivotTable1,PivotTable1,-1,AllowDetails
Public Property Get AllowDetails() As Boolean
    AllowDetails = PivotTable1.AllowDetails
End Property

Public Property Let AllowDetails(ByVal New_AllowDetails As Boolean)
    PivotTable1.AllowDetails() = New_AllowDetails
    PropertyChanged "AllowDetails"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=PivotTable1,PivotTable1,-1,AllowCustomOrdering
Public Property Get AllowCustomOrdering() As Boolean
    AllowCustomOrdering = PivotTable1.AllowCustomOrdering
End Property

Public Property Let AllowCustomOrdering(ByVal New_AllowCustomOrdering As Boolean)
    PivotTable1.AllowCustomOrdering() = New_AllowCustomOrdering
    PropertyChanged "AllowCustomOrdering"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=PivotTable1,PivotTable1,-1,AllowPropertyToolbox
Public Property Get AllowPropertyToolbox() As Boolean
    AllowPropertyToolbox = PivotTable1.AllowPropertyToolbox
End Property

Public Property Let AllowPropertyToolbox(ByVal New_AllowPropertyToolbox As Boolean)
    PivotTable1.AllowPropertyToolbox() = New_AllowPropertyToolbox
    PropertyChanged "AllowPropertyToolbox"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=PivotTable1,PivotTable1,-1,AllowGrouping
Public Property Get AllowGrouping() As Boolean
    AllowGrouping = PivotTable1.AllowGrouping
End Property

Public Property Let AllowGrouping(ByVal New_AllowGrouping As Boolean)
    PivotTable1.AllowGrouping() = New_AllowGrouping
    PropertyChanged "AllowGrouping"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=PivotTable1,PivotTable1,-1,DisplayExpandIndicator
Public Property Get DisplayExpandIndicator() As Boolean
    DisplayExpandIndicator = PivotTable1.DisplayExpandIndicator
End Property

Public Property Let DisplayExpandIndicator(ByVal New_DisplayExpandIndicator As Boolean)
    PivotTable1.DisplayExpandIndicator() = New_DisplayExpandIndicator
    PropertyChanged "DisplayExpandIndicator"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=PivotTable1,PivotTable1,-1,DisplayOfficeLogo
Public Property Get DisplayOfficeLogo() As Boolean
    DisplayOfficeLogo = PivotTable1.DisplayOfficeLogo
End Property

Public Property Let DisplayOfficeLogo(ByVal New_DisplayOfficeLogo As Boolean)
    PivotTable1.DisplayOfficeLogo() = New_DisplayOfficeLogo
    PropertyChanged "DisplayOfficeLogo"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=PivotTable1,PivotTable1,-1,DisplayScreenTips
Public Property Get DisplayScreenTips() As Boolean
    DisplayScreenTips = PivotTable1.DisplayScreenTips
End Property

Public Property Let DisplayScreenTips(ByVal New_DisplayScreenTips As Boolean)
    PivotTable1.DisplayScreenTips() = New_DisplayScreenTips
    PropertyChanged "DisplayScreenTips"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=PivotTable1,PivotTable1,-1,DisplayToolbar
Public Property Get DisplayToolbar() As Boolean
    DisplayToolbar = PivotTable1.DisplayToolbar
End Property

Public Property Let DisplayToolbar(ByVal New_DisplayToolbar As Boolean)
    PivotTable1.DisplayToolbar() = New_DisplayToolbar
    PropertyChanged "DisplayToolbar"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=PivotTable1,PivotTable1,-1,DisplayPropertyToolbox
Public Property Get DisplayPropertyToolbox() As Boolean
    DisplayPropertyToolbox = PivotTable1.DisplayPropertyToolbox
End Property

Public Property Let DisplayPropertyToolbox(ByVal New_DisplayPropertyToolbox As Boolean)
    PivotTable1.DisplayPropertyToolbox() = New_DisplayPropertyToolbox
    PropertyChanged "DisplayPropertyToolbox"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=PivotTable1,PivotTable1,-1,DisplayAlerts
Public Property Get DisplayAlerts() As Boolean
    DisplayAlerts = PivotTable1.DisplayAlerts
End Property

Public Property Let DisplayAlerts(ByVal New_DisplayAlerts As Boolean)
    PivotTable1.DisplayAlerts() = New_DisplayAlerts
    PropertyChanged "DisplayAlerts"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=PivotTable1,PivotTable1,-1,DisplayFieldList
Public Property Get DisplayFieldList() As Boolean
    DisplayFieldList = PivotTable1.DisplayFieldList
End Property

Public Property Let DisplayFieldList(ByVal New_DisplayFieldList As Boolean)
    PivotTable1.DisplayFieldList() = New_DisplayFieldList
    PropertyChanged "DisplayFieldList"
End Property

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    PivotTable1.AllowFiltering = PropBag.ReadProperty("AllowFiltering", True)
    PivotTable1.AllowDetails = PropBag.ReadProperty("AllowDetails", True)
    PivotTable1.AllowCustomOrdering = PropBag.ReadProperty("AllowCustomOrdering", True)
    PivotTable1.AllowPropertyToolbox = PropBag.ReadProperty("AllowPropertyToolbox", False)
    PivotTable1.AllowGrouping = PropBag.ReadProperty("AllowGrouping", True)
    PivotTable1.DisplayExpandIndicator = PropBag.ReadProperty("DisplayExpandIndicator", False)
    PivotTable1.DisplayOfficeLogo = PropBag.ReadProperty("DisplayOfficeLogo", False)
    PivotTable1.DisplayScreenTips = PropBag.ReadProperty("DisplayScreenTips", False)
    PivotTable1.DisplayToolbar = PropBag.ReadProperty("DisplayToolbar", True)
    PivotTable1.DisplayPropertyToolbox = PropBag.ReadProperty("DisplayPropertyToolbox", False)
    PivotTable1.DisplayAlerts = PropBag.ReadProperty("DisplayAlerts", True)
    PivotTable1.DisplayFieldList = PropBag.ReadProperty("DisplayFieldList", False)
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("AllowFiltering", PivotTable1.AllowFiltering, True)
    Call PropBag.WriteProperty("AllowDetails", PivotTable1.AllowDetails, True)
    Call PropBag.WriteProperty("AllowCustomOrdering", PivotTable1.AllowCustomOrdering, True)
    Call PropBag.WriteProperty("AllowPropertyToolbox", PivotTable1.AllowPropertyToolbox, False)
    Call PropBag.WriteProperty("AllowGrouping", PivotTable1.AllowGrouping, True)
    Call PropBag.WriteProperty("DisplayExpandIndicator", PivotTable1.DisplayExpandIndicator, False)
    Call PropBag.WriteProperty("DisplayOfficeLogo", PivotTable1.DisplayOfficeLogo, False)
    Call PropBag.WriteProperty("DisplayScreenTips", PivotTable1.DisplayScreenTips, False)
    Call PropBag.WriteProperty("DisplayToolbar", PivotTable1.DisplayToolbar, True)
    Call PropBag.WriteProperty("DisplayPropertyToolbox", PivotTable1.DisplayPropertyToolbox, False)
    Call PropBag.WriteProperty("DisplayAlerts", PivotTable1.DisplayAlerts, True)
    Call PropBag.WriteProperty("DisplayFieldList", PivotTable1.DisplayFieldList, False)
End Sub