_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de

Option Explicit
Public Grid As sevDataGrid2.sevGrid
 
Public Event ButtonClick()
Public Event ReportStart()
Public Event ReportFinish()
Public Event MenuClick(ByVal Item As Long, ByVal Key As String, ByRef bCancel _
  As Boolean)
Public Event ColumnViewChanged(ByVal sColumn As String)
Public Event ColumnEntryLoading(ByVal sColumn As String, ByRef sCaption As _
  String, ByRef bShow As Boolean)
 
Private Sub scmdExport_Click()
    scmdExport.ShowPopUpMenu
End Sub
 
 
Public Sub AddReportHeader(sTitle As String, Optional sData As String)
    If Grid Is Nothing Then Exit Sub
    ' Seitenkopf mit Grafik
    Dim sHTML As String
    With Grid
        sHTML = "<p><TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0><TR>" & _
                "<TD><IMG SRC=""stdlogo.jpg""></TD></TR></TABLE></P>" & _
                "<br/><P>{DATA}</P><H1>{TITLE}</H1>"
 
        sHTML = Replace$(sHTML, "{TITLE}", sTitle, , , vbTextCompare)
        sHTML = Replace$(sHTML, "{DATA}", sData, , , vbTextCompare)
 
        .HTMLPrint sHTML
        .HTMLTableTitle = sTitle & " WebReport"
    End With
 
End Sub
 
Private Sub scmdExport_MenuClick(ByVal Item As Long, ByVal Key As String)
Dim bStop As Boolean
RaiseEvent ButtonClick
If Grid Is Nothing Then Exit Sub
RaiseEvent MenuClick(Item, Key, bStop)
If bStop Then Exit Sub
 
If Grid.Rows = 0 And Left$(Key, 4) = "intp" Then
    MsgBox ("Es sind keine Daten zum Exportieren vorhanden!")
    Exit Sub
End If
 
Select Case Key
    Case "intpExport"
    RaiseEvent ReportStart
        Call DoXLSExport
    RaiseEvent ReportFinish
    Case "intpWebEx"
        Call DoHTMLExport
    Case Else
        If Left$(Key, 4) = "GCS_" Then
            scmdExport.MenuButton(Key).Checked = Not scmdExport.MenuButton( _
              Key).Checked
            Grid.Columns(Mid$(Key, 5)).Visible = scmdExport.MenuButton( _
            Key).Checked
            DoEvents
            Grid.RefreshEx
            RaiseEvent ColumnViewChanged(Mid$(Key, 5))
        End If
End Select
End Sub
 
Private Sub UserControl_Resize()
    '<EhHeader>
    On Error Resume Next
    '</EhHeader>
UserControl.Height = 315
UserControl.Width = 615
End Sub
 
 
Public Property Get Button() As sevCommand3.Command
    Set Button = scmdExport
End Property
 
Public Sub LoadColumnMenu()
On Error Resume Next
 
    Dim I As Long, sKey As String, bShow As Boolean, sCaption As String
    Call DeleteColumnMenu
    Call scmdExport.AddMenuButton("-", "hlGridCols")
    For I = 1 To Grid.Cols
        sKey = Grid.Columns(I).Key
        sCaption = Grid.Columns(I).Caption
        bShow = Not ((sKey = sCaption Or Trim$(sCaption) = "") And Grid.Columns( _
          I).Visible = False)
        RaiseEvent ColumnEntryLoading(sKey, sCaption, bShow)
 
        If bShow Then
            scmdExport.AddMenuButton(Trim$(sCaption), "GCS_" & sKey).Checked = _
              Grid.Columns(I).Visible
        End If
    Next
End Sub
 
Public Sub DeleteColumnMenu()
On Error Resume Next
    Dim I As Long
    If Not scmdExport.MenuButton("hlGridCols") Is Nothing Then
        For I = scmdExport.MenuButtonCount To 1 Step -1
            If Left$(scmdExport.MenuButton(I).Key, 4) = "GCS_" Then Call _
              scmdExport.RemoveMenuButton(scmdExport.MenuButton(I).Key)
        Next
        Call scmdExport.RemoveMenuButton("hlGridCols")
    End If
End Sub

-------------------------------------------
Follow the White Rabbit !!!

Public Sub DoHTMLExport()
    If Grid Is Nothing Then Exit Sub
    If Grid.Rows = 0 Then Exit Sub
 
    Grid.HTMLShowNavigation = False
    Grid.ReportStatusText = ""
    Grid.HTMLUseScreenFormating = True
    RaiseEvent ReportStart
    Grid.DoHTMLReport Folder_Temp & "export.htm"
    RaiseEvent ReportFinish
    Grid.HTMLShowReportModal
    Grid.HTMLKillFiles
End Sub
 
Public Function DoXLSExport(optional sPath as String) As Boolean
    Dim lret As Long
    Dim sFilter As String
    If trim(sPath) ="" Then
        sFilter = "Excel File (*.xls)|*.xls|CSV File (*.csv)|*.csv"
        lret = cdlgSaveFile(sPath, "Export speichern ...", CurDir$, sFilter, _
          "xls", Grid.hwnd, 0)
    End If
    If lret = 0 Then Exit Function
 
    If LCase$(GetFilenameExt(sPath)) = "csv" Then
        Call Grid.DoExport(sPath, EXPORT_CSV, , , EXPORT_FIELD_DISPLAYVALUE, , _
          , ";")
    Else
        Call Grid.DoExport(sPath, EXPORT_XLS, , , EXPORT_FIELD_DISPLAYVALUE)
    End If
    ExportGrid = True
End Function

set GridButton.Grid = sevGrid1
GridButton.LoadColumnMenu

-------------------------------------------
Follow the White Rabbit !!!