Tipp 0365 UserForm-Einstellungen speichern (INI-Datei)
Autor/Einsender:
Datum:
  Angie
13.10.2003
Entwicklungsumgebung:   Excel 97
Die in einer UserForm gemachten Einstellungen lassen sich auf sehr einfache Weise mit der API-Funktion WritePrivateProfileString in einer INI-Datei speichern und mit GetPrivateProfileSection wieder auslesen.
In diesem Beispiel wurde statt der API-Funktion GetPrivateProfileString, mit der die Werte, die einem Schlüssel in einem bestimmten Abschnitt zugeordnet sind, einzeln aus einer INI-Datei ausgelesen werden, die API-Funktion GetPrivateProfileSection verwendet. Mit GetPrivateProfileSection werden alle Schlüssel und Werte aus einem Abschnitt (Section) in einer privaten Initialisierungsdatei ausgelesen, wobei unter Windows 9x die Größe des zu lesenden Abschnitts 32 KB nicht überschreiten darf.
Soll die INI-Datei für mehrere Benutzer verwendet werden, lässt sich das Beispiel für Excel und Word relativ schnell ergänzen, der Benutzername kann mit Application.UserName ermittelt werden.
 
Option Explicit

Private Declare Function GetPrivateProfileSection Lib "kernel32" _
    Alias "GetPrivateProfileSectionA" (ByVal Section As String, _
    ByVal Buffer As String, ByVal Size As Long, ByVal FileName _
    As String) As Long

Private Declare Function WritePrivateProfileString Lib "kernel32" _
    Alias "WritePrivateProfileStringA" (ByVal Section As String, _
    ByVal Key As String, ByVal Setting As String, ByVal FileName _
    As String) As Long

Private Const INI_DELIMITER  As String = "="
Private Const TXT_DELIMITER  As String = "~|~"

Public Function GetUserDataINI(ByVal UserFrm As Object) As Boolean
  Dim strINIFileName As String
  Dim strINISection  As String
  Dim varSettings    As Variant
  Dim intUBound      As Integer
  Dim i              As Integer

  Dim ctl            As Control
  Dim varValue       As Variant

  strINIFileName = GetINIFileName
  If Len(strINIFileName) = 0 Then
    Exit Function
  Else
    If Len(Dir(strINIFileName, vbNormal)) = 0 Then
      Exit Function
    End If
  End If

  strINISection = UserFrm.Name
  varSettings = GetINISection(strINIFileName, strINISection)

  If UBound(varSettings) = -1 Then Exit Function

  On Error Resume Next
  intUBound = UBound(varSettings, 2)

  For i = 0 To intUBound
    Set ctl = UserFrm.Controls(varSettings(0, i))

    If Not ctl Is Nothing Then
      varValue = varSettings(1, i)

      If TypeOf ctl Is MSForms.TextBox Then
        If InStr(1, varValue, TXT_DELIMITER) Then
          #If VBA6 Then
            varValue = VBA.Replace(varValue, _
                  TXT_DELIMITER, Chr$(13) + Chr$(10), 1)
          #Else
            varValue = Replace(varValue, _
                  TXT_DELIMITER, Chr$(13) + Chr$(10), 1)
          #End If
        End If

        ctl.Text = varValue

      ElseIf TypeOf ctl Is MSForms.ListBox Or _
             TypeOf ctl Is MSForms.ComboBox Then

        If IsNumeric(varValue) Then
          ctl.ListIndex = Int(varValue)
        End If

      Else
        If IsNumeric(varValue) Then
          ctl.Value = Int(varValue)
        End If
      End If

      Set ctl = Nothing
    End If
  Next
  On Error GoTo 0

  Erase varSettings

  GetUserDataINI = True
End Function

Private Function GetINIFileName() As String
  Dim strPath     As String
  Dim strFilename As String
  Dim nPos        As Long

  strPath = ActiveWorkbook.Path

  If Len(strPath) <> 0 Then
    If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"

    strFilename = ActiveWorkbook.Name
    #If VBA6 Then
      nPos = VBA.InStrRev(strFilename, ".")
    #Else
      nPos = InStrRev(strFilename, ".")
    #End If
    If nPos > 0 Then
      strFilename = Left$(strFilename, nPos - 1)
    End If

    GetINIFileName = strPath & strFilename & ".ini"
  End If
End Function

Private Function GetINISection(ByVal FileName As String, _
      Section As String) As Variant

  Const BufferSize = 32767

  Dim strBuffer     As String
  Dim lngRetVal     As Long

  Dim varItems      As Variant
  Dim varItem       As Variant
  Dim varSettings() As String

  Dim intUBound     As Integer
  Dim i             As Integer

  strBuffer = Space$(BufferSize)
  lngRetVal = GetPrivateProfileSection( _
        Section, strBuffer, BufferSize, FileName)

  If lngRetVal = 0 Then
    ReDim varSettings(-1 To -1)
    GetINISection = varSettings
    Exit Function
  End If

  #If VBA6 Then
    varItems = VBA.Split(Left$(strBuffer, lngRetVal), Chr$(0))
  #Else
    varItems = Split(Left$(strBuffer, lngRetVal), Chr$(0))
  #End If

  If Len(varItems(UBound(varItems))) = 0 Then
    intUBound = UBound(varItems) - 1
  Else
    intUBound = UBound(varItems)
  End If

  ReDim varSettings(0 To 1, 0 To intUBound)

  For i = 0 To intUBound
    #If VBA6 Then
      varItem = VBA.Split(varItems(i), INI_DELIMITER, 2)
    #Else
      varItem = Split(varItems(i), INI_DELIMITER, 2)
    #End If
    varSettings(0, i) = varItem(0)
    varSettings(1, i) = varItem(1)
  Next

  GetINISection = varSettings
End Function

Public Sub SaveUserDataINI(ByVal UserFrm As Object)
  Dim strINIFileName As String
  Dim strINISection  As String

  Dim ctl            As Control
  Dim varValue       As Variant

  strINIFileName = GetINIFileName
  If Len(strINIFileName) = 0 Then
    MsgBox "Die UserForm-Einstellung konnten nicht " & _
          "gespeichert werden !", _
          vbOKOnly + vbInformation, Title:="VB-fun-Demo"

    Exit Sub
  End If

  strINISection = UserFrm.Name

  For Each ctl In UserFrm.Controls
    If TypeOf ctl Is MSForms.TextBox Or _
       TypeOf ctl Is MSForms.OptionButton Or _
       TypeOf ctl Is MSForms.CheckBox Or _
       TypeOf ctl Is MSForms.ListBox Or _
       TypeOf ctl Is MSForms.ComboBox Then

      If TypeOf ctl Is MSForms.TextBox Then
        varValue = ctl.Text

        If InStr(1, varValue, Chr$(13) + Chr$(10)) Then
          #If VBA6 Then
            varValue = VBA.Replace(varValue, _
                  Chr$(13) + Chr$(10), TXT_DELIMITER, 1)
          #Else
            varValue = Replace(varValue, _
                  Chr$(13) + Chr$(10), TXT_DELIMITER, 1)
          #End If
        End If

      ElseIf TypeOf ctl Is MSForms.ListBox Or _
             TypeOf ctl Is MSForms.ComboBox Then
        varValue = Int(ctl.ListIndex)

      Else
        varValue = Int(ctl.Value)
      End If

      SaveINISetting strINIFileName, strINISection, _
            ctl.Name, CStr(varValue)
    End If
  Next
End Sub

Private Sub SaveINISetting(ByVal FileName As String, _
      ByVal Section As String, ByVal Key As String, _
      ByVal Setting As String)

  Dim lngRetVal As Long

  lngRetVal = WritePrivateProfileString( _
                  Section, Key, Setting, FileName)
End Sub
 
Links zum Thema
Excel - UserForm-Einstellungen speichern (Tabellenblatt)
Hinweis
Die im Download befindlichen *.bas-Dateien (Module zum Speichern und Einlesen der UserForm-Einstellungen und die Ersatzfunktionen Split, Replace und InStrRev für Office 97) können im VB-Editor des entsprechenden Office-Programms importiert werden.
Für Word und PowerPoint sind lediglich kleine Änderungen bei der Ermittlung des Dateinamens für die INI-Datei notwendig, ansonsten kann der Code 1:1 in den angegebenen Office-Programmen eingesetzt werden.

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
Anwendung/VBA-Version
Access 97
Access 2000
Access XP
Access 2003
Access 2007
Access 2010
Excel 97
Excel 2000
Excel XP
Excel 2003
Excel 2007
Excel 2010
Word 97
Word 2000
Word XP
Word 2003
Word 2007
Word 2010
PPT 97
PPT 2000
PPT XP
PPT 2003
PPT 2007
PPT 2010
Outlook 97
Outlook 2000
Outlook XP
Outlook 2003
Outlook 2007
Outlook 2010


Download  (57,1 kB) Downloads bisher: [ 2015 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Dienstag, 31. Mai 2011