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 !!!