Private Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Private Declare Function mailto Lib "shell32.dll" _
   Alias "ShellExecuteA" (ByVal hWnd As Long, _
   ByVal lpOperation As String, ByVal lpFile As String, _
   ByVal lpParameters As String, ByVal lpDirectory As String, _
   ByVal nShowCmd As Long) As Long
   
Public Steuerelement As Control
Public ArbMappe As String, ArbBlatt As String
Dim Aktuell1 As Boolean, Aktuell2 As Boolean, Dat As Boolean, AM As Boolean, WS As Boolean
Dim Höhe1 As Single, Höhe2 As Single
Dim ID As String
Dim Arbeitsmappe As Workbook, Tabelle As Worksheet
Dim AnzTab%, ZählerD%, ZählerW%, ZählerSSuffix%, ZählerSPräfix%
Dim Rahmen As Frame

Sub MainFrmExprt()
  Me.Show
End Sub

Private Sub UserForm_initialize()
  LogModi = False
  If GetSetting("Exprt", "Settings", "Xlstart") = "" Then
    SaveSetting "Exprt", "Settings", "Xlstart", "Falsch"
    SaveSetting "Exprt", "Settings", "Xlstart2", "Falsch"
    SaveSetting "Exprt", "Settings", "Status", "Wahr"
    SaveSetting "Exprt", "Settings", "QuickInfo", "Wahr"
    SaveSetting "Exprt", "Settings", "Log", "Falsch"
    SaveSetting "Exprt", "Settings", "LogPfad", "C:\Exprt.log"
  ElseIf GetSetting("Exprt", "Settings", "Xlstart") = "Wahr" Then
    MultiPage1.Pages(1).CbxXlstart.Value = True
  Else
    MultiPage1.Pages(1).CbxXlstart.Value = False
  End If
  If GetSetting("Exprt", "Settings", "Xlstart2") = "Wahr" Then
    MultiPage1.Pages(1).CbxXlstart2.Value = True
  Else
    MultiPage1.Pages(1).CbxXlstart2.Value = False
  End If
  If GetSetting("Exprt", "Settings", "Status") = "Wahr" Then
    MultiPage1.Pages(1).CbxStatus.Value = True
  Else
    MultiPage1.Pages(1).CbxStatus.Value = False
  End If
  If GetSetting("Exprt", "Settings", "QuickInfo") = "Wahr" Then
    MultiPage1.Pages(1).CbxQuickInfo.Value = True
  Else
    MultiPage1.Pages(1).CbxQuickInfo.Value = False
  End If
  If GetSetting("Exprt", "Settings", "Log") = "Wahr" Then
    MultiPage1.Pages(1).CbxLog.Value = True
  Else
    MultiPage1.Pages(1).CbxLog.Value = False
  End If
  MultiPage1.Pages(1).TxtLog.Text = GetSetting("Exprt", "Settings", "LogPfad")
End Sub

Private Sub MultiPage1_enter()
  Dim Datei

  On Error Resume Next
  If Aktuell1 = True Then Exit Sub
  Aktuell1 = True
  Höhe1 = -9
  For Each Arbeitsmappe In Workbooks
    ID = UCase(Arbeitsmappe.Name)
    If Me.CbxXlstart.Value = False Then
      Datei = Dir(Application.StartupPath & "\")
      Do
        If ID = UCase(Datei) Then
          GoTo Weiter
        End If
        Datei = Dir
      Loop Until Datei = ""
    End If
    If Me.CbxXlstart2.Value = False Then
      Datei = Dir(Application.AltStartupPath & "\")
      Do
        If ID = UCase(Datei) Then
          GoTo Weiter
        End If
        Datei = Dir
      Loop Until Datei = ""
    End If
    If Len(ID) > 40 Then
      ID = Mid(ID, 1, 37) & " ..."
    End If
    Set Rahmen = MultiPage1.Pages(0).FrameWorkbook
    AM = False
    WS = False
    Dat = True
    Call NeuerButton
    Dat = False
    AM = True
    Call NeuerButton
    AM = False
    For Each Tabelle In Arbeitsmappe.Sheets
      ID = "worksheet: " & Tabelle.Name
      WS = True
      Call NeuerButton
    Next Tabelle
    Set Rahmen = Nothing
Weiter:
  Next Arbeitsmappe
  If AnzTab > 6 Then
    With MultiPage1.Pages(0).FrameWorkbook
      .ScrollBars = fmScrollBarsVertical
      .ScrollHeight = (1 + 0.14 * (AnzTab - 6)) * FrameWorkbook.Height
    End With
  Else
    MultiPage1.Pages(0).FrameWorkbook.KeepScrollBarsVisible = fmScrollBarsNone
  End If
End Sub

Private Sub CmdÖffnen_Click()
  Dim Datei

  Me.CmdÖffnen.TakeFocusOnClick = False
  Datei = Application.GetOpenFilename(Title:="Open file")
  If Datei = False Then
    Exit Sub
  End If
  On Error GoTo Ende
  Workbooks.Open Datei
  Set Arbeitsmappe = ActiveWorkbook
  ID = UCase(ActiveWorkbook.Name)
  If Len(ID) > 40 Then
    ID = Mid(ID, 1, 37) & " ..."
  End If
  Set Rahmen = MultiPage1.Pages(0).FrameWorkbook
  AM = False
  WS = False
  Dat = True
  Call NeuerButton
  Dat = False
  AM = True
  Call NeuerButton
  AM = False
  For Each Tabelle In ActiveWorkbook.Sheets
    ID = "worksheet: " & Tabelle.Name
    WS = True
    Call NeuerButton
  Next Tabelle
  Set Rahmen = Nothing
  If AnzTab > 6 Then
    With MultiPage1.Pages(0).FrameWorkbook
      .ScrollBars = fmScrollBarsVertical
      .ScrollHeight = (1 + 0.14 * (AnzTab - 6)) * FrameWorkbook.Height
    End With
  Else
    MultiPage1.Pages(0).FrameWorkbook.KeepScrollBarsVisible = fmScrollBarsNone
  End If
  Set Rahmen = Nothing
  Call cbxWorksheet_change
  Call cbxWorksheet_change
  Call cbxWorkbook_change
  Call cbxWorkbook_change
  MultiPage1.Pages(0).FrameWorkbook.Scroll , fmScrollActionEnd
  Set Arbeitsmappe = Nothing
  Exit Sub
Ende:
End Sub

Private Sub NeuerButton()
  Dim NeuButton As Control

  If Dat = True Then
    Set NeuButton = Rahmen.Controls.Add("Forms.Label.1")
  Else
    Set NeuButton = Rahmen.Controls.Add("Forms.checkbox.1")
  End If
  AnzTab = AnzTab + 1
  If Dat = True Then
    ZählerD = ZählerD + 1
    ZählerSPräfix = ZählerSPräfix + 1
    ZählerSSuffix = 0
  ElseIf WS = True Then
    ZählerSSuffix = ZählerSSuffix + 1
  Else
    ZählerW = ZählerW + 1
  End If
  If AM = True Then
    Höhe1 = Höhe1 + 13
  ElseIf WS = True Then
    Höhe1 = Höhe1 + 18
  Else
    Höhe1 = Höhe1 + 27
  End If
  With NeuButton
      .Top = Höhe1
    If AM <> True Then
      .Caption = ID
    Else
      .Caption = "workbook"
    End If
    .Left = 10
    If Dat = True Then
      .Name = "DatName" & ZählerD
    ElseIf WS = True Then
      .Name = "CbxS" & ZählerSPräfix & ZählerSSuffix
      .Tag = Tabelle.Parent.Name
    Else
      .Name = "CbxW" & ZählerW
      .Tag = Arbeitsmappe.Name
    End If
    If Dat = True Then
      .Font.Bold = True
    End If
    .Width = 230
    .Height = 18
  End With
End Sub

Private Sub CmdEntschlüsseln_Click()
  Dim Höhe As Single, Ausgewaehlt As Boolean

  Höhe = MultiPage1.Pages(0).FrameWorkbook.ScrollTop
  Me.CmdEntschlüsseln.TakeFocusOnClick = False
  For Each Steuerelement In MultiPage1.Pages(0).FrameWorkbook.Controls
    If Steuerelement.Name Like "CbxW*" Then
      If Steuerelement.Value = True Then
        Ausgewaehlt = True
        ArbMappe = Steuerelement.Tag
        Call Decrypt.Mappe(ArbMappe)
      End If
    End If
  Next Steuerelement
  For Each Steuerelement In MultiPage1.Pages(0).FrameWorkbook.Controls
    If Steuerelement.Name Like "CbxS*" Then
      If Steuerelement.Value = True Then
        Ausgewaehlt = True
        ArbMappe = Steuerelement.Tag
        ArbBlatt = Mid(Steuerelement.Caption, 12)
        Call Decrypt.Blatt(ArbMappe, ArbBlatt)
      End If
    End If
  Next Steuerelement
  Application.StatusBar = False
  If Ausgewaehlt = False Then
    If Me.CbxStatus.Value = True Then
      Status "No components selected"
    End If
  End If
  On Error Resume Next
  MultiPage1.Pages(0).FrameWorkbook.SetFocus
  MultiPage1.Pages(0).FrameWorkbook.ScrollTop = Höhe
End Sub

Private Sub cbxWorkbook_change()
  Dim Höhe As Single, s As Boolean

  Höhe = MultiPage1.Pages(0).FrameWorkbook.ScrollTop
  For Each Steuerelement In MultiPage1.Pages(0).FrameWorkbook.Controls
    If CbxWorkbook.Value = True Then
      If Steuerelement.Name Like "CbxW*" Then
        Steuerelement.Value = True
        s = True
      End If
    Else
      If Steuerelement.Name Like "CbxW*" Then
        Steuerelement.Value = False
      End If
    End If
  Next Steuerelement
  MultiPage1.Pages(0).FrameWorkbook.SetFocus
  MultiPage1.Pages(0).FrameWorkbook.ScrollTop = Höhe
End Sub

Private Sub cbxWorksheet_change()
  Dim Höhe As Single, s As Boolean

  Höhe = MultiPage1.Pages(0).FrameWorkbook.ScrollTop
  For Each Steuerelement In MultiPage1.Pages(0).FrameWorkbook.Controls
    If CbxWorksheet.Value = True Then
      If Steuerelement.Name Like "CbxS*" Then
        Steuerelement.Value = True
        s = True
      End If
    Else
      If Steuerelement.Name Like "CbxS*" Then
        Steuerelement.Value = False
      End If
    End If
  Next Steuerelement
  MultiPage1.Pages(0).FrameWorkbook.SetFocus
  MultiPage1.Pages(0).FrameWorkbook.ScrollTop = Höhe
End Sub

Private Sub CmdLog_Click()
  Dim bInfo As BROWSEINFO
  Dim Path As String
  Dim R As Long, X As Long, Pos As Integer
  With bInfo
    .pidlRoot = 0&
    .lpszTitle = "Please choose path for log-file:"
  End With
  bInfo.ulFlags = &H1
  X = SHBrowseForFolder(bInfo)
  Path = Space$(512)
  R = SHGetPathFromIDList(ByVal X, ByVal Path)
  If R Then
    Pos = InStr(Path, Chr$(0))
    If Mid(Left(Path, Pos - 1), Pos - 1) = "\" Then
      TxtLog.Text = Left(Path, Pos - 1) & "Exprt.log"
    Else
      TxtLog.Text = Left(Path, Pos - 1) & "\Exprt.log"
    End If
  End If
End Sub

Private Sub CbxLog_change()
  If CbxLog.Value = True Then
    With TxtLog
      .Enabled = True
      .BackStyle = fmBackStyleOpaque
    End With
    CmdLog.Enabled = True
  Else
    LogModi = False
    With TxtLog
      .Enabled = False
      .BackStyle = fmBackStyleTransparent
    End With
    CmdLog.Enabled = False
  End If
End Sub

Private Sub eMail_click()
  Call mailto(0&, "Open", "mailto:" + "Michael Velten <michnet@michnet.de>", "", "", 1)
End Sub

Private Sub CmdBeenden_Click()
  Unload Me
End Sub

Private Sub UserForm_Terminate()
  Dim LogDat

  SaveSetting "Exprt", "Settings", "Xlstart", MultiPage1.Pages(1).CbxXlstart.Value
  SaveSetting "Exprt", "Settings", "Xlstart2", MultiPage1.Pages(1).CbxXlstart2.Value
  SaveSetting "Exprt", "Settings", "Status", MultiPage1.Pages(1).CbxStatus.Value
  SaveSetting "Exprt", "Settings", "QuickInfo", MultiPage1.Pages(1).CbxQuickInfo.Value
  SaveSetting "Exprt", "Settings", "Log", MultiPage1.Pages(1).CbxLog.Value
  SaveSetting "Exprt", "Settings", "LogPfad", MultiPage1.Pages(1).TxtLog.Text
  If LogModi = True Then
    LogDat = FrmExprt.TxtLog.Text
    Open LogDat For Append As #1
      Print #1, "---"
    Close #1
  End If
  Application.StatusBar = False
End Sub

Private Sub CbxQuickInfo_Change()
  If Me.CbxQuickInfo.Value = True Then
    With Me
      .CbxXlstart.ControlTipText = "all files of the Xlstart-directory will be listed in the ""Workbooks/Worksheets""-menu"
      .CbxXlstart2.ControlTipText = "all files of the additional Xlstart-directory will be listed in the ""Workbooks/Worksheets""-menu"
      .CbxStatus.ControlTipText = "shows information on all decrypting operations in ""status display"""
      .CbxQuickInfo.ControlTipText = "shows infos like this"
      .CbxLog.ControlTipText = "creates a file in the directory listed below containing information on decrypting operations"
      .CmdLog.ControlTipText = "changes directory for creating log-file"
      .CmdBeenden.ControlTipText = "exits program"
      .CmdEntschlüsseln.ControlTipText = "decrypts selected components"
      .eMail.ControlTipText = "email to author: Michael Velten <michnet@michnet.de>"
      .CmdÖffnen.ControlTipText = "opens an additional file"
      .CbxWorkbook.ControlTipText = "selects all open workbooks in ""Workbooks/Worksheets""-menu"
      .CbxWorksheet.ControlTipText = "selects all open worksheets in ""Workbooks/Worksheets""-menu"
  End With
  Else
    Application.StatusBar = False
    With Me
      .CbxXlstart.ControlTipText = ""
      .CbxXlstart2.ControlTipText = ""
      .CbxStatus.ControlTipText = ""
      .CbxQuickInfo.ControlTipText = ""
      .CbxLog.ControlTipText = ""
      .CmdLog.ControlTipText = ""
      .CmdBeenden.ControlTipText = ""
      .CmdEntschlüsseln.ControlTipText = ""
      .eMail.ControlTipText = ""
      .CmdÖffnen.ControlTipText = ""
      .CbxWorkbook.ControlTipText = ""
      .CbxWorksheet.ControlTipText = ""
    End With
  End If
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Application.StatusBar = False
End Sub

Private Sub eMail_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Me.CbxQuickInfo.Value = True Then Application.StatusBar = "email to author: Michael Velten <michnet@michnet.de>"
End Sub

Private Sub CmdEntschlüsseln_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Me.CbxQuickInfo.Value = True Then Application.StatusBar = "decrypts selected components"
End Sub

Private Sub CmdBeenden_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Me.CbxQuickInfo.Value = True Then Application.StatusBar = "exits program"
End Sub

Private Sub CmdÖffnen_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Me.CbxQuickInfo.Value = True Then Application.StatusBar = "opens an additional file"
End Sub

Private Sub CbxWorksheet_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Me.CbxQuickInfo.Value = True Then Application.StatusBar = "selects all open worksheets in ""Workbooks/Worksheets""-menu"
End Sub

Private Sub CbxWorkbook_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Me.CbxQuickInfo.Value = True Then Application.StatusBar = "selects all open workbooks in ""Workbooks/Worksheets""-menu"
End Sub

Private Sub FrameWorkbook_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Application.StatusBar = False
End Sub

Private Sub MultiPage1_MouseMove(ByVal Index As Long, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Application.StatusBar = False
End Sub

Private Sub TxtStatus_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Application.StatusBar = False
End Sub

Private Sub CbxXlstart_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Me.CbxQuickInfo.Value = True Then Application.StatusBar = "all files of the Xlstart-directory will be listed in the ""Workbooks/Worksheets""-menu"
End Sub

Private Sub CbxXlstart2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Me.CbxQuickInfo.Value = True Then Application.StatusBar = "all files of the additional Xlstart-directory will be listed in the ""Workbooks/Worksheets""-menu"
End Sub

Private Sub CbxStatus_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Me.CbxQuickInfo.Value = True Then Application.StatusBar = "shows information on all decrypting operations in ""status display"""
End Sub

Private Sub CbxQuickInfo_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Me.CbxQuickInfo.Value = True Then Application.StatusBar = "shows infos like this"
End Sub

Private Sub CbxLog_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Me.CbxQuickInfo.Value = True Then Application.StatusBar = "creates a file in the directory listed below containing information on decrypting operations"
End Sub

Private Sub CmdLog_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Me.CbxQuickInfo.Value = True Then Application.StatusBar = "changes directory for creating log-file"
End Sub

Private Sub FrmProtokoll_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Application.StatusBar = False
End Sub

Private Sub FrmAnzeige_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Application.StatusBar = False
End Sub