Office Logo VBA Klicken für Hauptseite von "The SOSCQ Page"   Klicken für "The SOSCQ Page - VBA/VB-Codebeispiele" Klicken für Startseite von 'xlam - Excel and more!'

Prüfen, ob eine Dateinummer bereits verwendet wird

.Beschreibung
VBA bietet standardmässig keine Möglichkeit zum Überprüfen, ob im Zusammenhang mit der Open-Anweisung eine bestimmte Dateinummer bereits benutzt wird. Die folgenden Beispiele zeigen, wie man eine solche Funktion selber programmieren kann.

Ablauflogik:
1. Abfragen, ob die nächste freie Dateinummer (VBA-Funktion FreeFile) grösser ist als die zu überprüfende Dateinummer.
2. Abfragen, ob die nächste freie Dateinummer (VBA-Funktion FreeFile) gleich ist wie die zu überprüfende Dateinummer.
3. Abfragen, ob die zu überprüfende Dateinummer verwendet werden kann.

- Laufzeitfehler 53: Datei nicht gefunden (bedeutet, dass die Dateinummer nicht verwendet wird)

- Laufzeitfehler 55: Datei bereits geöffnet (bedeutet, dass die Dateinummer bereits verwendet wird)

» Codebeispiel #1: Dieses exemplarische Beispiel öffnet als Ausgangslage zuerst die Datei "EineDatei.txt" drei Mal, mit den Dateinummern 1, 2 und 4. Überprüft wird, ob die Dateinummer 3 bereits verwendet wird (abgelegt als Konstante intFileNumberToCheck).

» Codebeispiel #2: Hier wurde die oben vorgestellte Ablauflogik in einer Funktion namens IsFileNumberFree gekapselt.

.VBA-Code #1
Public Sub CheckIfFileNumberIsUsed()
  Const intFileNumberToCheck As Integer = 3
  'Als Ausgangslage drei Dateinummern belegen

  Open "C:\Daten\EineDatei.txt" For Input As #1
  Open "C:\Daten\EineDatei.txt" For Input As #2
  Open "C:\Daten\EineDatei.txt" For Input As #4
  If FreeFile() > intFileNumberToCheck Then
    MsgBox "Die Dateinummer " & CStr(intFileNumberToCheck) & " wird bereits verwendet.", vbInformation
  ElseIf FreeFile() = intFileNumberToCheck Then
    MsgBox "Die Dateinummer " & CStr(intFileNumberToCheck) & " wird nicht verwendet.", vbInformation
  Else
    On Error Resume Next
    Open Environ("windir") & "\dummy" For Input As #intFileNumberToCheck
    If Err.Number = 0 Then
      Close #intFileNumberToCheck
      MsgBox "Die Dateinummer " & CStr(intFileNumberToCheck) & " wird nicht verwendet.", vbInformation
    ElseIf Err.Number = 53 Then
      MsgBox "Die Dateinummer " & CStr(intFileNumberToCheck) & " wird nicht verwendet.", vbInformation
    ElseIf Err.Number = 55 Then
      MsgBox "Die Dateinummer " & CStr(intFileNumberToCheck) & " wird bereits verwendet.", vbInformation
    Else
      MsgBox "Fehler " & CStr(Err.Number) & " aufgetreten!", vbExclamation
    End If
  End If
  Reset
End Sub

.VBA-Code #2
Public Function IsFileNumberFree(ByVal FileNumber As Integer) As Boolean
  If FreeFile() > FileNumber Then
    IsFileNumberFree = False
  ElseIf FreeFile() = FileNumber Then
    IsFileNumberFree = True
  Else
    On Error Resume Next
    Open Environ("windir") & "\dummy" For Input As #FileNumber
    If Err.Number = 0 Then
      Close #FileNumber
      IsFileNumberFree = True
    ElseIf Err.Number = 55 Then
      IsFileNumberFree = False
    ElseIf Err.Number = 53 Then
      IsFileNumberFree = True
    Else
      IsFileNumberFree = False
    End If
  End If
  On Error GoTo 0
End Function

'*** Aufruf ***
Sub TestCall()
  MsgBox "Dateinummer frei? " & CStr(IsFileNumberFree(3))
End Sub

Weitere Informationen

VBA-Befehle und -Funktionen

 

Verwandte Codebeispiele

Nächste freie Dateinummer ermitteln

To Top


Prüfen, ob eine aktive Arbeitsmappe existiert

.Beschreibung
Gewöhnlich gibt es in Microsoft Excel eine so genannte aktive Arbeitsmappe. Das ist immer diejenige Arbeitsmappe, die vom Benutzer gerade bearbeitet wird. Allerdings gibt es mehrere Situationen, mindestens deren zwei, in denen keine aktive Arbeitsmappe existiert. Diese Situationen sind folgende:
1. Es ist keine Arbeitsmappe geöffnet.
2. Es ist bzw. sind mehrere Arbeitsmappen geöffnet, wobei diese jedoch ausgeblendet sind.

Der folgende Programmcode überprüft, ob es eine aktive Arbeitsmappe gibt.

.VBA-Code
Public Sub CheckIfActiveWorkbookExists()
  If Not ActiveWorkbook Is Nothing Then
    MsgBox "Es gibt eine aktive Arbeitsmappe.", vbInformation
  Else
    MsgBox "Es gibt keine aktive Arbeitsmappe.", vbInformation
  End If
End Sub

Verwandte Codebeispiele

Name der aktiven Arbeitsmappe abfragen

Prüfen, ob eine Arbeitsmappe bereits geöffnet ist

To Top


Prüfen, ob ein externer Datenbereich beim Öffnen der Arbeitsmappe aktualisiert wird

.Beschreibung
Dieses Codebeispiel zeigt, wie man herausfindet, ob die Daten eines externen Datenbereiches (einer so genannten QueryTable) automatisch aktualisiert werden, wenn die Arbeitsmappe geöffnet wird. Das Beispiel geht davon aus, dass sich auf dem aktiven Blatt ein externer Datenbereich befindet.

.VBA-Code
Public Sub GetRefreshDataOnWorkbookOpen()
  If ActiveSheet.QueryTables(1).RefreshOnFileOpen = True Then
    MsgBox "Externe Daten werden beim Öffnen der Arbeitsmappe aktualisiert."

  Else
    MsgBox "Externe Daten werden beim Öffnen der Arbeitsmappe nicht aktualisiert."
  End If
End Sub

Verwandte Codebeispiele

Aktualisierungseinstellung eines externen Datenbereiches beim Öffnen der Arbeitsmappe ändern

Prüfen, ob ein externer Datenbereich im Hintergrund aktualisiert wird

To Top


Aktualisierungseinstellung eines externen Datenbereiches beim Öffnen der Arbeitsmappe ändern

.Beschreibung
Diese Codebeispiele zeigen, wie man die Einstellung "Aktualisieren beim Öffnen der Arbeitsmappe" eines externen Datenbereiches ändert.

» Codebeispiel #1: Hier wird die Aktualisierungseinstellung aktiviert. Es wird der erste externe Datenbereich des aktiven Arbeitsblattes verwendet.

» Codebeispiel #2: Hier wird die Aktualisierungseinstellung deaktiviert. Es wird der erste externe Datenbereich des aktiven Arbeitsblattes verwendet.

» Codebeispiel #3: Hier wird die Aktualisierungseinstellung aktiviert. Es wird der externe Datenbereich mit der Bezeichnung "Aktienkurse" des aktiven Arbeitsblattes verwendet.

.VBA-Code #1
Public Sub ActivateRefreshDataOnWorkbookOpen()
  ActiveSheet.QueryTables(1).RefreshOnFileOpen = True
End Sub

.VBA-Code #2
Public Sub DeactivateRefreshDataOnWorkbookOpen()
  ActiveSheet.QueryTables(1).RefreshOnFileOpen = False
End Sub

.VBA-Code #3
Public Sub SetRefreshDataOnWorkbookOpen()
  ActiveSheet.QueryTables("Aktienkurse").RefreshOnFileOpen = True
End Sub

Verwandte Codebeispiele

Prüfen, ob ein externer Datenbereich beim Öffnen der Arbeitsmappe aktualisiert wird

Prüfen, ob ein externer Datenbereich im Hintergrund aktualisiert wird

To Top


Prüfen, ob die Daten eines externen Datenbereiches vor dem Speichern der Arbeitsmappe entfernt werden

.Beschreibung
Das nachstehende Codebeispiel fragt die Eigenschaft SaveData eines externen Datenbereiches ab, die festlegt, ob die externen Daten vor dem Speichern der Arbeitsmappe entfernt oder mitgespeichert werden.

Im Beispiel wird angenommen, dass sich der externe Datenbereich auf dem aktiven Arbeitsblatt befindet.

.VBA-Code
Public Sub GetSaveDataWithWorkbook()
  MsgBox "Externe Daten speichern: " & ActiveSheet.QueryTables(1).SaveData
End Sub

Verwandte Codebeispiele

Prüfen, ob ein externer Datenbereich beim Öffnen der Arbeitsmappe aktualisiert wird

To Top


Prüfen, ob ein externer Datenbereich im Hintergrund aktualisiert wird

.Beschreibung
Die Eigenschaft BackgroundQuery legt fest, ob ein externer Datenbereich im Hintergrund aktualisiert werden kann.

Im Beispiel wird angenommen, dass sich der externe Datenbereich auf dem aktiven Arbeitsblatt befindet.

.VBA-Code
Public Sub GetRefreshInBackground()
  MsgBox "Externe Daten speichern: " & ActiveSheet.QueryTables(1).BackgroundQuery
End Sub

Verwandte Codebeispiele

Prüfen, ob ein externer Datenbereich beim Öffnen der Arbeitsmappe aktualisiert wird

Aktualisierungseinstellung eines externen Datenbereiches beim Öffnen der Arbeitsmappe ändern

To Top


Verbindungsinformation (Connection) eines externen Datenbereiches abfragen

.Beschreibung
Ein externer Datenbereich ist, wie der Name schon andeutet, ein Bereich, dessen Daten aus einer externen Datenquelle stammen. Externe Daten können gewöhnlich von einer Datenbankabfrage, einer Web-Abfrage oder einer Pivot-Tabelle angefordert bzw. dargestellt werden. Immer wenn Daten aus einer Datenbank oder dem Web stammen, wird eine so genannte Verbindungsinformation benutzt. Diese ist in der Eigenschaft Connection abgelegt. Diese Eigenschaft existiert für zwei Objekte: PivotCache und QueryTable.

» Das Codebeispiel #1 fragt die Connection-Eigenschaft von PivotCache ab. Wenn beispielsweise die Pivot-Tabelle auf einer Datenbankabfrage basiert, enthält Connection zum Beispiel

ODBC;DBQ=C:\Daten;DefaultDir=C:\Daten;Driver={Microsoft Text Driver (*.txt; *.csv)};
DriverId=27;Extensions=None,asc,csv,dat,log,tab,txt;FIL=text;MaxBufferSize=2048;
MaxScanRows=25;PageTimeout=5;SafeTransactions=0;Threads=3;UserCommitSync=Yes;

» Das Codebeispiel #2 fragt die Connection-Eigenschaft von QueryTable ab. Wenn beispielsweise eine Web-Abfrage verwendet wird, enthält Connection zum Beispiel

URL;http://webservices.pcquote.com/cgi-bin/excel.exe

.VBA-Code #1
Public Sub GetConnectionPivotCache()
  MsgBox ActiveSheet.PivotTables(1).PivotCache.Connection
End Sub

.VBA-Code #2
Public Sub GetConnectionQueryTable()
  MsgBox ActiveSheet.QueryTables(1).Connection
End Sub

Verwandte Codebeispiele

SQL-Query eines externen Datenbereiches abfragen

To Top


SQL-Query eines externen Datenbereiches abfragen

.Beschreibung
Externe Datenbereiche, die auf einer Datenbankabfrage basieren, können einen SQL-Query besitzen. Der Datenbereich kann dabei eine Pivot-Tabelle (PivotCache) oder eine so genannten QueryTable sein.

MsgBox ActiveSheet.PivotTables(1).PivotCache.SQL

Beispiel von SQL einer Datenbank-Abfrage:
SELECT Textdatei1.Name, Textdatei2.Vorname_Nachname FROM Textdatei1.txt Textdatei1, Textdatei2.txt Textdatei2 WHERE Textdatei1.Name = Textdatei2.Vorname_Nachname

.VBA-Code #1
Public Sub GetSQLPivotCache()
  MsgBox ActiveSheet.PivotTables(1).PivotCache.SQL
End Sub

.VBA-Code #2
Public Sub GetSQLQueryTable()
  MsgBox ActiveSheet.QueryTables(1).SQL
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Verbindungsinformation (Connection) eines externen Datenbereiches abfragen

To Top


Dateiname der Datenquelle eines externen Datenbereiches abfragen

.Beschreibung
Eine Pivot-Tabelle kann Daten darstellen, deren Quelle
- eine MS Excel-Datenbank oder -Liste,
- eine externe Datenquelle,
- mehrere Konsolidierungsbereiche oder
- eine andere Pivot-Tabelle
ist.

 

Wenn eine Pivot-Tabelle Daten aus einer anderen Arbeitsmappe ("MS Excel-Datenbank/-Liste") darstellt, enthält die Eigenschaft SourceData einen externen Bezug, der sich aus Dateiname, Blattname und Zellbereich zusammensetzt. Wenn die andere Mappe in einem anderen Verzeichnis als die Mappe mit der Pivot-Tabelle liegt, ist zusätzlich der relative Pfad zur anderen Mappendatei enthalten.

 

[PivoTest.xls]Tabelle1!Z5S1:Z26S5

'\Daten\[Pivot-Test 2.xls]Tabelle2'!Z1S1:Z7S3

 

.VBA-Code
Public Sub GetSourceDataFilename()

End Sub

Verwandte Codebeispiele

...

To Top


Datenbankabfrage ausführen und als externer Datenbereich in ein Arbeitsblatt einfügen

.Beschreibung
Dieses Codebeispiel fügt einen neuen externen Datenbereich bei Zelle A1 des aktiven Arbeitsblattes ein. Die Daten werden von einer bestehenden Datenbankabfrage namens "Query1.dqy" geliefert.

.VBA-Code
Public Sub AddQueryTableFromDatabaaeQuery()
  With ActiveSheet.QueryTables.Add(Connection:= _
      "FINDER;C:\Programme\Microsoft Office\Abfragen\Query1.dqy", _
      Destination:=Range("A1"))
    .FieldNames = True
    .RefreshStyle = xlInsertDeleteCells
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .RefreshOnFileOpen = False
    .HasAutoFormat = True
    .BackgroundQuery = True
    .TablesOnlyFromHTML = True
    .Refresh BackgroundQuery:=False
    .SavePassword = True
    .SaveData = True
  End With
End Sub

Verwandte Codebeispiele

Web-Abfrage ausführen und als externer Datenbereich in ein Arbeitsblatt einfügen

To Top


Web-Abfrage ausführen und als externer Datenbereich in ein Arbeitsblatt einfügen

.Beschreibung
Dieses Codebeispiel fügt einen neuen externen Datenbereich in das aktive Arbeitsblatt ein. Die Daten werden von einer bestehenden Web-Abfrage geliefert.

.VBA-Code
Public Sub AddQueryTableFromWebQuery()

End Sub

Verwandte Codebeispiele

Datenbankabfrage ausführen und als externer Datenbereich in ein Arbeitsblatt einfügen

To Top


Arbeitsmappendateien eines bestimmten Autors auflisten

.Beschreibung
Dieses Codebeispiel listet alle Arbeitsmappen eines Ordners auf, die von einem bestimmten Autor erstellt wurden.

Die Konstante strFolder enthält den zu durchsuchenden Ordner. Sie können auch mehrere Ordner angeben, indem Sie die einzelnen Ordnerpfade durch Semikolons trennen (zum Beispiel "C:\Daten;C:\Excel\Dateien;D:\Statistik"). Die Konstante strProperty enthält die gesuchte Eigenschaft. In strPropertyValue ist der Eigenschaftswert abgelegt.

.VBA-Code
Public Sub ListWorkbookFilesOfAuthor()
  Const strFolder As String = "C:\Daten"
  Const strProperty As String = "Autor"
  Const strPropertyValue As String = "Philipp von Wartburg"
  Dim lngFiles As Integer
  Dim wksSheet As Worksheet
  With Application.FileSearch
    .NewSearch
    .LookIn = strFolder
    .SearchSubFolders = False
    .FileType = msoFileTypeExcelWorkbooks
    .FileName = "*.xls"
    .PropertyTests.Add Name:=strProperty, Condition:=msoConditionIsExactly, _
        Value:=strPropertyValue, Connector:=msoConnectorAnd
    If .Execute() > 0 Then
      Set wksSheet = ActiveWorkbook.Worksheets.Add
      With wksSheet
        .Range("A3:B3").Value = Array("Nr.", "Datei")
        .Range("A3:B3").Font.Bold = True
      End With
      For lngFiles = 1 To .FoundFiles.Count
        wksSheet.Cells(lngFiles + 3, 1).Value = lngFiles
        wksSheet.Cells(lngFiles + 3, 2).Value = .FoundFiles(lngFiles)
      Next lngFiles
      With wksSheet
        .Columns("A:B").AutoFit
        .Range("A1").Value = "Dateiliste (" & strProperty & " " & strPropertyValue & ")"
        .Range("A1").Font.Bold = True
        .Range("A1").Font.Size = .Range("A1").Font.Size + 1
      End With
      Set wksSheet = Nothing
    Else
      MsgBox "Es wurden keine Dateien mit diesen Suchkriterien gefunden.", vbInformation
    End If
  End With
End Sub

.Hinweis
Wenn die Suche eine Datei findet, auf die nicht zugegriffen werden kann, erscheint der Laufzeitfehler 70 "Zugriff verweigert". Der Fehler tritt bei der Codezeile

  wksSheet.Cells(lngFiles + 3, 2).Value = .FoundFiles(lngFiles)

auf, beispielsweise wenn der Benutzer keine Leseberechtigung für die betroffene Datei besitzt.

Weitere Informationen

VBA-Spezialthema: FileSearch-Object

 

Verwandte Codebeispiele

Arbeitsmappendateien eines bestimmten Bearbeiters auflisten

Arbeitsmappendateien eines bestimmten Benutzers auflisten

Arbeitsmappendateien einer bestimmten Firma auflisten

Datei in mehreren Ordnern suchen (alle Fundstellen anzeigen)

To Top


Arbeitsmappendateien eines bestimmten Bearbeiters auflisten

.Beschreibung
Dieses Codebeispiel erstellt eine Liste derjenigen Arbeitsmappendateien eines Ordners, die von einem bestimmten Benutzer bearbeitet wurden. Da die Arbeitsmappen bearbeitet wurden, wurden sie folglich von dem Benutzer zuletzt gespeichert. Das heisst, dass die Dokument-Eigenschaft "Zuletzt gespeichert von" gefiltert werden muss.

Die Konstante strFolder enthält den zu durchsuchenden Ordner. Sie können auch mehrere Ordner angeben, indem Sie die einzelnen Ordnerpfade durch Semikolons trennen (zum Beispiel "C:\Daten;C:\Excel\Dateien;D:\Statistik"). Die Konstante strProperty enthält die gesuchte Eigenschaft. In strPropertyValue ist der Eigenschaftswert abgelegt.

.VBA-Code
Public Sub ListWorkbookFilesOfLastEditedBy()
  Const strFolder As String = "C:\Daten"
  Const strProperty As String = "Zuletzt gespeichert von"
  Const strPropertyValue As String = "Philipp von Wartburg"
  Dim lngFiles As Integer
  Dim wksSheet As Worksheet
  With Application.FileSearch
    .NewSearch
    .LookIn = strFolder
    .SearchSubFolders = False
    .FileType = msoFileTypeExcelWorkbooks
    .FileName = "*.xls"
    .PropertyTests.Add Name:=strProperty, Condition:=msoConditionIsExactly, _
        Value:=strPropertyValue, Connector:=msoConnectorAnd
    If .Execute() > 0 Then
      Set wksSheet = ActiveWorkbook.Worksheets.Add
      With wksSheet
        .Range("A3:B3").Value = Array("Nr.", "Datei")
        .Range("A3:B3").Font.Bold = True
      End With
      For lngFiles = 1 To .FoundFiles.Count
        wksSheet.Cells(lngFiles + 3, 1).Value = lngFiles
        wksSheet.Cells(lngFiles + 3, 2).Value = .FoundFiles(lngFiles)
      Next lngFiles
      With wksSheet
        .Columns("A:B").AutoFit
        .Range("A1").Value = "Dateiliste (" & strProperty & " " & strPropertyValue & ")"
        .Range("A1").Font.Bold = True
        .Range("A1").Font.Size = .Range("A1").Font.Size + 1
      End With
      Set wksSheet = Nothing
    Else
      MsgBox "Es wurden keine Dateien mit diesen Suchkriterien gefunden.", vbInformation
    End If
  End With
End Sub

.Hinweis
Wenn die Suche eine Datei findet, auf die nicht zugegriffen werden kann, erscheint der Laufzeitfehler 70 "Zugriff verweigert". Der Fehler tritt bei der Codezeile

  wksSheet.Cells(lngFiles + 3, 2).Value = .FoundFiles(lngFiles)

auf, beispielsweise wenn der Benutzer keine Leseberechtigung für die betroffene Datei besitzt.

Weitere Informationen

VBA-Spezialthema: FileSearch-Object

 

Verwandte Codebeispiele

Arbeitsmappendateien eines bestimmten Autors auflisten

Arbeitsmappendateien eines bestimmten Benutzers auflisten

Datei in mehreren Ordnern suchen (alle Fundstellen anzeigen)

To Top


Arbeitsmappendateien eines bestimmten Benutzers auflisten

.Beschreibung
Dieses Codebeispiel erstellt eine Liste der Arbeitsmappen, die von einem bestimmten Benutzer zuletzt verwendet wurden. Es werden folgedessen auch alle Exceldateien aufgelistet, die durch den Benutzer lediglich geöffnet wurden, ohne dass sie der Benutzer gespeichert hat.

.VBA-Code
Public Sub ListWorkbookFilesOfUser()

End Sub

Weitere Informationen

VBA-Spezialthema: FileSearch-Object

 

Verwandte Codebeispiele

Arbeitsmappendateien eines bestimmten Autors auflisten

Arbeitsmappendateien eines bestimmten Bearbeiters auflisten

Arbeitsmappendateien einer bestimmten Firma auflisten

To Top


Arbeitsmappendateien einer bestimmten Firma auflisten

.Beschreibung
Mit diesem Codebeispiel wird eine Liste der Arbeitsmappen erstellt, die im Feld "Firma" der Dokument-Eigenschaften einen bestimmten Begriff enthalten. Im Beispiel wird als Firma "Muster AG" verwendet. Durchsucht wird der Ordner "C:\Daten" (ohne Unterverzeichnisse).

.VBA-Code
Public Sub ListWorkbookFilesOfCompany()
  Const strFolder As String = "C:\Daten"
  Const strProperty As String = "Firma"
  Const strPropertyValue As String = "Muster AG"
  Dim lngFiles As Integer
  Dim wksSheet As Worksheet
  With Application.FileSearch
    .NewSearch
    .LookIn = strFolder
    .SearchSubFolders = False
    .FileType = msoFileTypeExcelWorkbooks
    .FileName = "*.xls"
    .PropertyTests.Add Name:=strProperty, Condition:=msoConditionIsExactly, _
        Value:=strPropertyValue, Connector:=msoConnectorAnd
    If .Execute() > 0 Then
      Set wksSheet = ActiveWorkbook.Worksheets.Add
      With wksSheet
        .Range("A3:B3").Value = Array("Nr.", "Datei")
        .Range("A3:B3").Font.Bold = True
      End With
      For lngFiles = 1 To .FoundFiles.Count
        wksSheet.Cells(lngFiles + 3, 1).Value = lngFiles
        wksSheet.Cells(lngFiles + 3, 2).Value = .FoundFiles(lngFiles)
      Next lngFiles
      With wksSheet
        .Columns("A:B").AutoFit
        .Range("A1").Value = "Dateiliste (" & strProperty & " " & strPropertyValue & ")"
        .Range("A1").Font.Bold = True
        .Range("A1").Font.Size = .Range("A1").Font.Size + 1
      End With
      Set wksSheet = Nothing
    Else
      MsgBox "Es wurden keine Dateien mit diesen Suchkriterien gefunden.", vbInformation
    End If
  End With
End Sub

.Hinweis
Wenn die Suche eine Datei findet, auf die nicht zugegriffen werden kann, erscheint der Laufzeitfehler 70 "Zugriff verweigert". Der Fehler tritt bei der Codezeile

  wksSheet.Cells(lngFiles + 3, 2).Value = .FoundFiles(lngFiles)

auf, beispielsweise wenn der Benutzer keine Leseberechtigung für die betroffene Datei besitzt.

Weitere Informationen

VBA-Spezialthema: FileSearch-Object

 

Verwandte Codebeispiele

Arbeitsmappendateien eines bestimmten Autors auflisten

To Top


Arbeitsmappendateien eines bestimmten Themas auflisten

.Beschreibung
Mit diesem Codebeispiel wird eine Liste der Arbeitsmappen erstellt, die im Feld "Thema" der Dokument-Eigenschaften einen bestimmten Begriff enthalten. Im Beispiel wird der Begriff "Bilanz" verwendet. Durchsucht wird der Ordner "C:\Daten" (ohne Unterverzeichnisse).

.VBA-Code
Public Sub ListWorkbookFilesOfTopic()
  Const strFolder As String = "C:\Daten"
  Const strProperty As String = "Thema"
  Const strPropertyValue As String = "Bilanz"
  Dim lngFiles As Integer
  Dim wksSheet As Worksheet
  With Application.FileSearch
    .NewSearch
    .LookIn = strFolder
    .SearchSubFolders = False
    .FileType = msoFileTypeExcelWorkbooks
    .FileName = "*.xls"
    .PropertyTests.Add Name:=strProperty, Condition:=msoConditionIsExactly, _
        Value:=strPropertyValue, Connector:=msoConnectorAnd
    If .Execute() > 0 Then
      Set wksSheet = ActiveWorkbook.Worksheets.Add
      With wksSheet
        .Range("A3:B3").Value = Array("Nr.", "Datei")
        .Range("A3:B3").Font.Bold = True
      End With
      For lngFiles = 1 To .FoundFiles.Count
        wksSheet.Cells(lngFiles + 3, 1).Value = lngFiles
        wksSheet.Cells(lngFiles + 3, 2).Value = .FoundFiles(lngFiles)
      Next lngFiles
      With wksSheet
        .Columns("A:B").AutoFit
        .Range("A1").Value = "Dateiliste (" & strProperty & " " & strPropertyValue & ")"
        .Range("A1").Font.Bold = True
        .Range("A1").Font.Size = .Range("A1").Font.Size + 1
      End With
      Set wksSheet = Nothing
    Else
      MsgBox "Es wurden keine Dateien mit diesen Suchkriterien gefunden.", vbInformation
    End If
  End With

End Sub

.Hinweis
Wenn die Suche eine Datei findet, auf die nicht zugegriffen werden kann, erscheint der Laufzeitfehler 70 "Zugriff verweigert". Der Fehler tritt bei der Codezeile

  wksSheet.Cells(lngFiles + 3, 2).Value = .FoundFiles(lngFiles)

auf, beispielsweise wenn der Benutzer keine Leseberechtigung für die betroffene Datei besitzt.

Weitere Informationen

VBA-Spezialthema: FileSearch-Object

 

Verwandte Codebeispiele

Arbeitsmappendateien eines bestimmten Autors auflisten

To Top


Arbeitsmappendateien einer bestimmten Kategorie auflisten

.Beschreibung
Mit diesem Codebeispiel wird eine Liste der Arbeitsmappen erstellt, die im Feld "Kategorie" der Dokument-Eigenschaften einen bestimmten Begriff enthalten. Im Beispiel wird "Musterdatei" für die Kategorie verwendet. Durchsucht wird der Ordner "C:\Daten" (ohne Unterverzeichnisse).

.VBA-Code
Public Sub ListWorkbookFilesOfCategory()
  Const strFolder As String = "C:\Daten"
  Const strProperty As String = "Kategorie"
  Const strPropertyValue As String = "Musterdatei"
  Dim lngFiles As Integer
  Dim wksSheet As Worksheet
  With Application.FileSearch
    .NewSearch
    .LookIn = strFolder
    .SearchSubFolders = False
    .FileType = msoFileTypeExcelWorkbooks
    .FileName = "*.xls"
    .PropertyTests.Add Name:=strProperty, Condition:=msoConditionIsExactly, _
        Value:=strPropertyValue, Connector:=msoConnectorAnd
    If .Execute() > 0 Then
      Set wksSheet = ActiveWorkbook.Worksheets.Add
      With wksSheet
        .Range("A3:B3").Value = Array("Nr.", "Datei")
        .Range("A3:B3").Font.Bold = True
      End With
      For lngFiles = 1 To .FoundFiles.Count
        wksSheet.Cells(lngFiles + 3, 1).Value = lngFiles
        wksSheet.Cells(lngFiles + 3, 2).Value = .FoundFiles(lngFiles)
      Next lngFiles
      With wksSheet
        .Columns("A:B").AutoFit
        .Range("A1").Value = "Dateiliste (" & strProperty & " " & strPropertyValue & ")"
        .Range("A1").Font.Bold = True
        .Range("A1").Font.Size = .Range("A1").Font.Size + 1
      End With
      Set wksSheet = Nothing
    Else
      MsgBox "Es wurden keine Dateien mit diesen Suchkriterien gefunden.", vbInformation
    End If
  End With
End Sub

.Hinweis
Wenn die Suche eine Datei findet, auf die nicht zugegriffen werden kann, erscheint der Laufzeitfehler 70 "Zugriff verweigert". Der Fehler tritt bei der Codezeile

  wksSheet.Cells(lngFiles + 3, 2).Value = .FoundFiles(lngFiles)

auf, beispielsweise wenn der Benutzer keine Leseberechtigung für die betroffene Datei besitzt.

Weitere Informationen

VBA-Spezialthema: FileSearch-Object

 

Verwandte Codebeispiele

Arbeitsmappendateien eines bestimmten Autors auflisten

To Top


Arbeitsmappendateien eines Ordners auflisten

.Beschreibung
Mit den folgenden drei Codebeispielen können Sie eine Liste der Arbeitsmappendateien eines Ordners erstellen. Alle drei Beispiele liefern das gleiche Ergebnis, gehen jedoch bei der Überprüfung des Dateityps (Microsoft Excel-Arbeitsmappe) unterschiedlich vor. Verwenden Sie dasjenige Beispiel, welches Ihnen am ehesten zusagt.

» Codebeispiel #1: Überprüft, ob die rechten vier Zeichen des Dateinamens ".xls" sind.

» Codebeispiel #2: Überprüft, ob der Dateityp "Microsoft Excel-Arbeitsmappe" ist.

» Codebeispiel #3: Überprüft, ob die Datennamenerweiterung "xls" ist.

.VBA-Code #1
Public Sub ListWorkbookFiles1()
  Const strPath As String = "C:\Daten"

  Dim objFolder As Object
  Dim objFile As Object
  Dim wksSheet As Worksheet
  Dim intCounter As Integer
  Set objFolder = CreateObject("Scripting.FileSystemObject").GetFolder(strPath)
  If objFolder.Files.Count = 0 Then
    Set objFolder = Nothing
    Exit Sub
  End If
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  For Each objFile In objFolder.Files
    If LCase$(Right$(objFile.Name, 4)) = ".xls" Then

      intCounter = intCounter + 1
      wksSheet.Cells(intCounter, 1).Value = objFile.Name

    End If
  Next
  wksSheet.Columns("A").AutoFit
  Set objFolder = Nothing
  Set wksSheet = Nothing
End Sub

.VBA-Code #2
Public Sub ListWorkbookFiles2()
  Const strPath As String = "C:\Daten"

  Dim objFolder As Object
  Dim objFile As Object
  Dim wksSheet As Worksheet
  Dim intCounter As Integer
  Set objFolder = CreateObject("Scripting.FileSystemObject").GetFolder(strPath)
  If objFolder.Files.Count = 0 Then
    Set objFolder = Nothing
    Exit Sub
  End If
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  For Each objFile In objFolder.Files
    If objFile.Type = "Microsoft Excel-Arbeitsmappe" Then

      intCounter = intCounter + 1
      wksSheet.Cells(intCounter, 1).Value = objFile.Name

    End If
  Next
  wksSheet.Columns("A").AutoFit
  Set objFolder = Nothing
  Set wksSheet = Nothing
End Sub

.VBA-Code #3
Public Sub ListWorkbookFiles3()
  Const strPath As String = "C:\Daten"

  Dim objFSO As Object
  Dim objFolder As Object
  Dim objFile As Object
  Dim wksSheet As Worksheet
  Dim intCounter As Integer
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFSO.GetFolder(strPath)
  If objFolder.Files.Count = 0 Then
    Set objFolder = Nothing
    Set objFSO = Nothing
    Exit Sub
  End If
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  For Each objFile In objFolder.Files
    If LCase$(objFSO.GetExtensionName(objFile.Path)) = "xls" Then

      intCounter = intCounter + 1
      wksSheet.Cells(intCounter, 1).Value = objFile.Name

    End If
  Next
  wksSheet.Columns("A").AutoFit
  Set objFolder = Nothing

  Set objFSO = Nothing
  Set wksSheet = Nothing
End Sub

Weitere Informationen

VBA-Spezialthema: FileSystemObject (FSO)

 

Verwandte Codebeispiele

Dateien eines Ordners auflisten

To Top


Öffnen des in der Zelle angegebenen Ordners im Explorer mittels Doppelklick

.Beschreibung
Hier wird eine Lösung vorgestellt, wie ein in einer Zelle eingetragener Ordner im Windows Explorer geöffnet wird, indem man einen Doppelklick auf die Zelle ausführt. Im Beispiel wird davon ausgegangen, dass ein Arbeitsblatt mit dem Namen "Tabelle1" vorhanden ist.

Beim Öffnen der Arbeitsmappe wird durch das Auto_Open-Makro eingestellt, dass ein Doppelklick auf eine Zelle des Blattes "Tabelle1" an die Prozedur OpenExplorer weitergeleitet wird. Diese Einstellung wird beim Schliessen der Mappe wieder aufgehoben. Über Application.Caller erhält man den Inhalt der Zelle, auf die ein Doppelklick ausgeführt wurde. Anstelle der Konstante vbNormalFocus kann man auch eine andere Konstante für den Fensterstil angeben.

TODO: Windows Explorer öffnen mit FollowHyperlink

.VBA-Code
'Codemodul
Public Sub Auto_Open()
  Worksheets("Tabelle1").OnDoubleClick = "OpenExplorer"
End Sub

Public Sub Auto_Close()
  Worksheets("Tabelle1").OnDoubleClick = ""
End Sub

Public Sub OpenExplorer()
  Shell "Explorer.exe " & Application.Caller, vbNormalFocus
End Sub

.Hinweis
Die Shell-Anweisung bzw. die Befehlszeile des Windows Explorers kann auch relative Pfade entgegennehmen.

Weitere Informationen

Relative Pfade

Detaillierte Informationen über die Befehlszeilen-Parameters des Windows Explorers erhalten Sie hier:
  Command-Line Switches for Windows Explorer
  http://support.microsoft.com/?kbid=130510

To Top


Computer neu starten

.Beschreibung
Mit der API-Funktion ExitWindowEx kann man den Computer neu starten. Dazu muss für das erste Funktionsargument (Flags) die Zahl 2 angegeben werden.

.VBA-Code
'Deklarationsbereich
Declare Function ExitWindowsEx Lib "user32" (ByVal Flags As Long, _
   ByVal Reserved As Long) As Long

'Codemodul
Sub RebootComputer()
  ExitWindowsEx 2, 0
End Sub

Verwandte Codebeispiele

Windows beenden

Windows-Benutzer abmelden

Computer herunterfahren und ausschalten

To Top


Computer herunterfahren und ausschalten

.Beschreibung
Mit der API-Funktion ExitWindowEx kann man den Computer herunterfahren und ausschalten. Das erste Funktionsargument Flags wird dazu auf den Wert 1 gestellt.

.VBA-Code
'Deklarationsbereich
Declare Function ExitWindowsEx Lib "user32" (ByVal Flags As Long, _
   ByVal Reserved As Long) As Long

'Codemodul
Sub ShutdownComputer()
  ExitWindowsEx 1, 0
End Sub

Verwandte Codebeispiele

Windows beenden

Windows-Benutzer abmelden

Computer neu starten

To Top


Name der aktiven Arbeitsmappe abfragen

.Beschreibung
Der Name der aktiven Arbeitsmappe wird mit der Name-Eigenschaft des Workbook-Objektes abgefragt. ActiveWorkbook ist eine Eigenschaft von Application, die das Workbook-Objekt der aktiven Mappe liefert. Wenn es keine aktive Arbeitsmappe gibt, tritt der Laufzeitfehler 91 "Objektvariable oder With-Blockvariable nicht festgelegt" auf.

.VBA-Code
Public Sub GetActiveWorkbookName()
  MsgBox "Name der aktiven Arbeitsmappe: " & ActiveWorkbook.Name
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Workbook-Objektes

 

Verwandte Codebeispiele

Prüfen, ob eine aktive Arbeitsmappe existiert

Name der codeausführenden Arbeitsmappe abfragen

Name des aktiven VBA-Projektes abfragen

Name des aktiven Arbeitsblattes abfragen

Name des VBA-Projektes der aktiven Arbeitsmappe abfragen

To Top


Name der codeausführenden Arbeitsmappe abfragen

.Beschreibung
...

Bei ThisWorkbook in einem VBA-Programm kann nie ein Laufzeitfehler auftreten, weil es immer eine codeausführende Arbeitsmappe beziehungsweise ein geöffnetes VBA-Projekt gibt. Nur wenn man ThisWorkbook im Direktfenster des VBA-Editors verwendet und weder eine Arbeitsmappe noch ein Add-In geladen ist, erscheint der Laufzeitfehler 1004 "Anwendungs- oder objektdefinierter Fehler".

.VBA-Code
Public Sub GetThisWorkbookName()
  MsgBox "Name der codeausführenden Arbeitsmappe: " & ThisWorkbook.Name
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Workbook-Objektes

 

Verwandte Codebeispiele

Name der aktiven Arbeitsmappe abfragen

Name des aktiven VBA-Projektes abfragen

Name des VBA-Projektes der aktiven Arbeitsmappe abfragen

To Top


Name des aktiven Arbeitsblattes abfragen

.Beschreibung
Der Name des aktiven Arbeitsblattes wird mit der Name-Eigenschaft des Worksheet-Objektes abgefragt. ActiveSheet ist eine Eigenschaft von Application, die das Worksheet-Objekt des aktiven Blattes liefert. Wenn es kein aktives Arbeitsblatt gibt, tritt der Laufzeitfehler 91 "Objektvariable oder With-Blockvariable nicht festgelegt" auf.

.VBA-Code
Public Sub GetActiveWorksheetName()
  MsgBox "Name des aktiven Arbeitsblattes: " & ActiveSheet.Name
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Worksheet-Objektes

 

Verwandte Codebeispiele

Name der aktiven Arbeitsmappe abfragen

Typ des aktiven Arbeitsblattes abfragen

To Top


Name des aktiven VBA-Projektes abfragen

.Beschreibung
Der Name des aktiven VBA-Projektes ist der Name-Eigenschaft des Projektes abgelegt. Der Zugriff erfolgt via ActiveVBProject.

.VBA-Code
Public Sub GetActiveVBProjectName()
  MsgBox "Name des aktiven VBA-Projektes: " & Application.VBE.ActiveVBProject.Name
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Name der aktiven Arbeitsmappe abfragen

Name der codeausführenden Arbeitsmappe abfragen

Name des VBA-Projektes der aktiven Arbeitsmappe abfragen

To Top


Name des VBA-Projektes der aktiven Arbeitsmappe abfragen

.Beschreibung
Der Name des aktiven VBA-Projektes ist der Name-Eigenschaft des Projektes abgelegt. Der Zugriff erfolgt via ActiveWorkbook.VBProject.

.VBA-Code
Public Sub GetActiveWorkbookVBProjectName()
  MsgBox "Name des VBA-Projektes der aktiven Arbeitsmappe: " & ActiveWorkbook.VBProject.Name
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Name des aktiven VBA-Projektes abfragen

Name der aktiven Arbeitsmappe abfragen

Name der codeausführenden Arbeitsmappe abfragen

To Top


Typ des aktiven Arbeitsblattes abfragen

.Beschreibung
Jedes Arbeitsblatt einer Arbeitsmappe besitzt einen bestimmten Typ, wobei es insgesamt fünf verschiedene Typen gibt. Den Typ erhalten Sie durch Abfragen der Type-Eigenschaft des Worksheet-Objektes.

XlSheetType-Konstante Wert
xlWorksheet -4167
xlChart -4109
xlDialog -4116

Bei Diagrammblättern wird ein falscher Wert ausgegeben (3 statt -4109; 3 steht eigentlich für xlExcel4MacroSheet)!

Sheet.Type geht auch.

 

Als Alternative kann man auch die TypeName-Funktion von VBA einsetzen:

z.B. TypeName(ActiveSheet)

Blatt TypeName liefert...
Tabelle Worksheet
Diagramm Chart
Excel 4.0-Makrovorlage Worksheet
Internationale Makrovorlage Worksheet
Excel 5.0-Dialog DialogSheet

Wenn kein aktives Blatt existiert, gibt TypeName den Wert "Nothing" zurück.

.VBA-Code #1
Public Sub GetActiveWorksheetType1()
  MsgBox ActiveSheet.Type
End Sub

.VBA-Code #2
Public Sub GetActiveWorksheetType2()
  MsgBox TypeName(ActiveSheet)
End Sub

Verwandte Codebeispiele

Name des aktiven Arbeitsblattes abfragen

To Top


Typ eines Arbeitsblattes abfragen

.Beschreibung
Jedes Arbeitsblatt einer Arbeitsmappe besitzt einen bestimmten Typ, wobei es insgesamt fünf verschiedene Typen gibt. Den Typ erhalten Sie durch Abfragen der Type-Eigenschaft des Worksheet-Objektes.

XlSheetType-Konstante Wert
xlWorksheet -4167
xlChart -4109
xlDialog -4116

Bei Diagrammblättern wird ein falscher Wert ausgegeben (3 statt -4109; 3 steht eigentlich für xlExcel4MacroSheet)!

Sheet.Type geht auch.

 

» Codebeispiel #1: Diese Prozedur gibt den Typ eines Arbeitsblattes aus. Im Beispiel wird das aktive Arbeitsblatt verwendet (ActiveSheet).

» Codebeispiel #2: Wie Codebeispiel #1, jedoch als Funktion gekapselt. Das Argument objSheet muss mit Object deklariert sein (d.h. nicht mit Worksheet), da sonst bei einem Dialogblatt bereits beim Aufrufen der Funktion ein Laufzeitfehler auftritt! Im Beispiel wird der Typ des zweiten Blattes der aktiven Arbeitsmappe abgefragt.

.VBA-Code #1
Public Sub GetSheetType()
  Dim intSheetType As Integer
  On Error Resume Next
  intSheetType = ActiveSheet.Type
  If Err.Number = 0 Then
    Select Case intSheetType
      Case -4167
        MsgBox "Tabellenblatt"
      Case 3
        If ActiveSheet.ChartType >= 0 Then
          If Err.Number = 0 Then
            MsgBox "Diagrammblatt"
          Else
            Err.Clear
            MsgBox "Makroblatt"
          End If
        End If
      Case 4
        MsgBox "Intl. Makroblatt"
    End Select
  Else
    Err.Clear
    MsgBox "Dialogblatt"
  End If
End Sub

.VBA-Code #2
Public Function GetSheetTypeName(objSheet As Object) As String
  Dim intSheetType As Integer
  On Error Resume Next
  intSheetType = objSheet.Type
  If Err.Number = 0 Then
    Select Case intSheetType
      Case -4167
        GetSheetTypeName = "Tabellenblatt"
      Case 3
        If objSheet.ChartType >= 0 Then
          If Err.Number = 0 Then
            GetSheetTypeName = "Diagrammblatt"
          Else
            Err.Clear
            GetSheetTypeName = "Makroblatt"
          End If
        End If
      Case 4
        GetSheetTypeName = "Intl. Makroblatt"
      Case Else
        GetSheetTypeName = "Unbekannt"
    End Select
  Else
    Err.Clear
    GetSheetTypeName = "Dialogblatt"
  End If
End Function

'*** Aufruf ***
Sub TestCall()
  MsgBox "Blatttyp: " & GetSheetTypeName(ActiveWorkbook.Sheets(2))
End Sub

Verwandte Codebeispiele

Name des aktiven Arbeitsblattes abfragen

To Top


Prozeduren und Funktionen eines VBA-Projektes auflisten

.Beschreibung
Der hier vorgestellte Programmcode erstellt eine Liste sämtlicher in einem VBA-Projekt enthaltenen Prozeduren (Subs) und Funktionen (Functions). Die Liste wird auf einem neuen Arbeitsblatt der aktiven Arbeitsmappe erstellt. Pro Modul des VBA-Projektes wird eine Spalte des Arbeitsblattes verwendet. Es können daher die Prozeduren und Funktionen von maximal 256 Modulen aufgelistet werden.

Es werden alle Codezeilen sämtlicher Module des VBA-Projektes durchlaufen (CountOfLines) und der Prozedurname jeder Zeile abgefragt. Jeder gefundene Name wird auf dem Arbeitsblatt aufgelistet.

Im Beispiel wird das VBA-Projekt der aktiven Arbeitsmappe verwendet.

.VBA-Code
Public Sub ListVBProjectProcedures()
  Dim wksSheet As Worksheet
  Dim objComponent As VBComponent
  Dim intColumn As Integer
  Dim intRow As Integer
  Dim intLine As Integer
  Dim strProcName As String
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  For Each objComponent In ActiveWorkbook.VBProject.VBComponents
    If objComponent.Type = vbext_ct_ClassModule Or objComponent.Type = vbext_ct_Document Or objComponent.Type = vbext_ct_StdModule Then
      intRow = 1
      intColumn = intColumn + 1
      If intColumn > 256 Then
        MsgBox "Das VBA-Projekt enthält mehr Module als Tabellenspalten zur Verfügung stehen.", vbInformation
        Exit For
      End If
      With wksSheet.Cells(intRow, intColumn)
        .Value = objComponent.Name
        .Font.Bold = True
      End With
      With objComponent.CodeModule
        For intLine = 1 To .CountOfLines
          If .ProcOfLine(intLine, vbext_pk_Proc) > "" Then
            strProcName = .ProcOfLine(intLine, vbext_pk_Proc)
            If strProcName <> wksSheet.Cells(intRow, intColumn).Value Then
              intRow = intRow + 1
              wksSheet.Cells(intRow, intColumn).Value = strProcName
            End If
          End If
        Next intLine
      End With
    End If
  Next objComponent
  wksSheet.Range(wksSheet.Cells(1, 1), wksSheet.Cells(1, intColumn)).EntireColumn.AutoFit
  Set wksSheet = Nothing
End Sub

Verwandte Codebeispiele

API-Deklarationen eines VBA-Projektes auflisten

To Top


API-Deklarationen eines VBA-Projektes auflisten

.Beschreibung
Dieser Programmcode dient zum Erstellen einer Liste der in einem VBA-Projekt enthaltenen API-Deklarationen. Die Liste wird auf einem neuen Arbeitsblatt der aktiven Arbeitsmappe erstellt. Pro Modul des VBA-Projektes wird eine Spalte des Arbeitsblattes verwendet. Es können daher die API-Deklarationen von maximal 256 Modulen aufgelistet werden.

Eine API-Deklaration befindet sich immer im Deklarationsbereich eines Moduls. Daher werden alle Zeilen des Deklarationsbereiches durchlaufen (CountOfDeclarationLines) und überprüft, ob das Word "Declare" vorkommt. Ist das Wort enthalten, und die Zeile beginnt weder mit einem Apostroph-Zeichen noch mit Rem, so handelt es sich um eine Deklarationszeile. Hier ein Beispiel einer deklarierten API-Funktion:

  Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Im Beispiel wird das VBA-Projekt der aktiven Arbeitsmappe verwendet.

.VBA-Code
Public Sub ListVBProjectAPIDeclarations()
  Dim wksSheet As Worksheet
  Dim objComponent As VBComponent
  Dim intColumn As Integer
  Dim intRow As Integer
  Dim intLine As Integer
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  For Each objComponent In ActiveWorkbook.VBProject.VBComponents
    If objComponent.Type = vbext_ct_ClassModule Or objComponent.Type = vbext_ct_Document Or objComponent.Type = vbext_ct_StdModule Then
      intRow = 1
      intColumn = intColumn + 1
      If intColumn > 256 Then
        MsgBox "Das VBA-Projekt enthält mehr Module als Tabellenspalten zur Verfügung stehen.", vbInformation
        Exit For
      End If
      With wksSheet.Cells(intRow, intColumn)
        .Value = objComponent.Name
        .Font.Bold = True
      End With
      With objComponent.CodeModule
        For intLine = 1 To .CountOfDeclarationLines
          If InStr(.Lines(intLine, 1), "Declare") > 0 Then
            If Left$(LTrim$(.Lines(intLine, 1)), 1) <> "'" And Left$(LTrim$(.Lines(intLine, 1)), 3) <> "Rem" Then
              intRow = intRow + 1
              wksSheet.Cells(intRow, intColumn).Value = .Lines(intLine, 1)
            End If
          End If
        Next intLine
      End With
    End If
  Next objComponent
  wksSheet.Range(wksSheet.Cells(1, 1), wksSheet.Cells(1, intColumn)).EntireColumn.AutoFit
  Set wksSheet = Nothing
End Sub

Verwandte Codebeispiele

Prozeduren und Funktionen eines VBA-Projektes auflisten

To Top


Datei eines zuletzt bearbeiteten Dokumentes von Windows öffnen

.Beschreibung
Im Windows-Startmenü gibt es den Menüeintrag "Dokumente", welcher eine Liste mit den zuletzt bearbeiteten Dokumenten zeigt. Das folgende Codebeispiel zeigt, wie man eine in der Liste enthaltene Dokumentdatei öffnen kann.

...

.VBA-Code
Public Sub OpenFileOfRecentDocumentsList()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Prüfen, ob eine Datei in der Liste der zuletzt bearbeiteten Dokumente von Windows eingetragen ist

Datei in die Liste der zuletzt bearbeiteten Dokumente von Windows aufnehmen

Zuletzt bearbeitete Dokumente von Windows auflisten

Liste der zuletzt bearbeiteten Dokumente von Windows löschen

To Top


Prüfen, ob eine Arbeitsmappe in der Liste der zuletzt verwendeten Dateien eingetragen ist

.Beschreibung
Im Menü "Datei" von Microsoft Excel befinden sich bis zu 9 Einträge mit den Namen der zuletzt verwendeten Dateien. Dieses Codebeispiel überprüft, ob eine bestimmte Datei in der Liste eingetragen ist.

.VBA-Code
Public Sub IsWorkbookInRecentFilesList()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Prüfen, ob eine Datei in der Liste der zuletzt bearbeiteten Dokumente von Windows eingetragen ist

To Top


Prüfen, ob eine Datei in der Liste der zuletzt bearbeiteten Dokumente von Windows eingetragen ist

.Beschreibung
Dieser Programmcode überprüft, ob eine bestimmte Datei in der Liste der zuletzt bearbeiteten Dokumente von Windows eingetragen ist. Diese Liste erreicht man über das Menüelement "Dokumente" der Windows Start-Schaltfläche.

.VBA-Code
Public Sub IsFileInRecentDocumentsList()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Datei eines zuletzt bearbeiteten Dokumentes von Windows öffnen

Datei in die Liste der zuletzt bearbeiteten Dokumente von Windows aufnehmen

Zuletzt bearbeitete Dokumente von Windows auflisten

Liste der zuletzt bearbeiteten Dokumente von Windows löschen

Prüfen, ob eine Arbeitsmappe in der Liste der zuletzt verwendeten Dateien eingetragen ist

To Top


Screenshot des aktiven Fensters in die Zwischenablage kopieren

.Beschreibung
In Windows lässt sich jederzeit ein Screenshot des aktiven Fensters erzeugen, indem man die Tastenkombination Alt+Druck (Print Screen) drückt. Möchte man das gleiche mittels VBA-Programm machen, so benötigt man ziemlich viel Code.

Die "Application.Wait"-Codezeile dient nur zu Demonstrationszwecken. Sie bewirkt, dass zwischen Prozedurausführung und Erstellung des Screenshots 5 Sekunden lang gewartet wird. Sie haben dadurch Zeit, ein beliebiges Fenster zu aktivieren. Ohne dieses Warten würde der Screenshot unmittelbar nach dem Prozedurstart und folgedessen immer vom VBA-Editor-Fenster erstellt. Die Codezeile muss in der operativen Version des Programmcodes entfernt werden.

.VBA-Code
'Deklarationsbereich
Type RECT_Type
  left As Long
  top As Long
  right As Long
  bottom As Long
End Type
Declare Function GetForegroundWindow Lib "User32" () As Long
Declare Function GetDesktopWindow Lib "User32" () As Long
Declare Sub GetWindowRect Lib "User32" (ByVal Hwnd As Long, lpRect As RECT_Type)
Declare Function GetDC Lib "User32" (ByVal Hwnd As Long) As Long
Declare Function CreateCompatibleDC Lib "Gdi32" (ByVal hdc As Long) As Long
Declare Function CreateCompatibleBitmap Lib "Gdi32" (ByVal hdc As Long, ByVal nWidth As Long, _
   ByVal nHeight As Long) As Long
Declare Function SelectObject Lib "Gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function BitBlt Lib "Gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, _

   ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
   ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
Declare Function OpenClipboard Lib "User32" (ByVal Hwnd As Long) As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function ReleaseDC Lib "User32" (ByVal Hwnd As Long, ByVal hdc As Long) As Long
Declare Function DeleteDC Lib "Gdi32" (ByVal hdc As Long) As Long
Const SRCCOPY = &HCC0020
Const CF_BITMAP = 2

'Codemodul
Public Sub MakeScreenshot()
  Dim FormHwnd As Long
  Dim DeskHwnd As Long
  Dim hdc As Long
  Dim hdcMem As Long
  Dim rect As RECT_Type
  Dim junk As Long
  Dim fwidth As Long
  Dim fheight As Long
  Dim hBitmap As Long

  Application.Wait Now + TimeValue("0:00:05")   '<- Diese Zeile dient nur zu Demonstrationszwecken
  DeskHwnd = GetDesktopWindow()
  FormHwnd = GetForegroundWindow()
  Call GetWindowRect(FormHwnd, rect)

  fwidth = rect.right - rect.left
  fheight = rect.bottom - rect.top

  hdc = GetDC(DeskHwnd)
  hdcMem = CreateCompatibleDC(hdc)
  hBitmap = CreateCompatibleBitmap(hdc, fwidth, fheight)
  If hBitmap <> 0 Then
    junk = SelectObject(hdcMem, hBitmap)
    junk = BitBlt(hdcMem, 0, 0, fwidth, fheight, hdc, rect.left, rect.top, SRCCOPY)
    junk = OpenClipboard(DeskHwnd)
    junk = EmptyClipboard()
    junk = SetClipboardData(CF_BITMAP, hBitmap)
    junk = CloseClipboard()
  End If

  junk = DeleteDC(hdcMem)
  junk = ReleaseDC(DeskHwnd, hdc)
End Sub

Verwandte Codebeispiele

Screenshot eines Fensters in die Zwischenablage kopieren

Screenshot eines Benutzerformulares in die Zwischenablage kopieren

Screenshot des Anwendungsfensters der aktuellen Excel-Sitzung in die Zwischenablage kopieren

Screenshot des gesamten Bildschirmes in die Zwischenablage kopieren

To Top


Screenshot eines Fensters in die Zwischenablage kopieren

.Beschreibung
In Windows lässt sich jederzeit ein Screenshot des aktiven Fensters erzeugen, indem man die Tastenkombination Alt+Druck (Print Screen) drückt. Möchte man das gleiche mittels VBA-Programm machen, so benötigt man ziemlich viel Code.

Die "Application.Wait"-Codezeile dient nur zu Demonstrationszwecken. Sie bewirkt, dass zwischen Prozedurausführung und Erstellung des Screenshots 5 Sekunden lang gewartet wird. Sie haben dadurch Zeit, ein beliebiges Fenster zu aktivieren. Ohne dieses Warten würde der Screenshot unmittelbar nach dem Prozedurstart und folgedessen immer vom VBA-Editor-Fenster erstellt. Die Codezeile muss in der operativen Version des Programmcodes entfernt werden.

.VBA-Code
'Deklarationsbereich
Type RECT_Type
  left As Long
  top As Long
  right As Long
  bottom As Long
End Type
Declare Function GetForegroundWindow Lib "User32" () As Long
Declare Function GetDesktopWindow Lib "User32" () As Long
Declare Sub GetWindowRect Lib "User32" (ByVal Hwnd As Long, lpRect As RECT_Type)
Declare Function GetDC Lib "User32" (ByVal Hwnd As Long) As Long
Declare Function CreateCompatibleDC Lib "Gdi32" (ByVal hdc As Long) As Long
Declare Function CreateCompatibleBitmap Lib "Gdi32" (ByVal hdc As Long, ByVal nWidth As Long, _
   ByVal nHeight As Long) As Long
Declare Function SelectObject Lib "Gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function BitBlt Lib "Gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, _

   ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
   ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
Declare Function OpenClipboard Lib "User32" (ByVal Hwnd As Long) As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function ReleaseDC Lib "User32" (ByVal Hwnd As Long, ByVal hdc As Long) As Long
Declare Function DeleteDC Lib "Gdi32" (ByVal hdc As Long) As Long
Const SRCCOPY = &HCC0020
Const CF_BITMAP = 2

'Codemodul
Public Sub MakeScreenshot()
  Dim FormHwnd As Long
  Dim DeskHwnd As Long
  Dim hdc As Long
  Dim hdcMem As Long
  Dim rect As RECT_Type
  Dim junk As Long
  Dim fwidth As Long
  Dim fheight As Long
  Dim hBitmap As Long

  Application.Wait Now + TimeValue("0:00:05")   '<- Diese Zeile dient nur zu Demonstrationszwecken
  DeskHwnd = GetDesktopWindow()
  FormHwnd = GetForegroundWindow()
  Call GetWindowRect(FormHwnd, rect)

  fwidth = rect.right - rect.left
  fheight = rect.bottom - rect.top

  hdc = GetDC(DeskHwnd)
  hdcMem = CreateCompatibleDC(hdc)
  hBitmap = CreateCompatibleBitmap(hdc, fwidth, fheight)
  If hBitmap <> 0 Then
    junk = SelectObject(hdcMem, hBitmap)
    junk = BitBlt(hdcMem, 0, 0, fwidth, fheight, hdc, rect.left, rect.top, SRCCOPY)
    junk = OpenClipboard(DeskHwnd)
    junk = EmptyClipboard()
    junk = SetClipboardData(CF_BITMAP, hBitmap)
    junk = CloseClipboard()
  End If

  junk = DeleteDC(hdcMem)
  junk = ReleaseDC(DeskHwnd, hdc)
End Sub

Verwandte Codebeispiele

Screenshot des aktiven Fensters in die Zwischenablage kopieren

Screenshot eines Benutzerformulares in die Zwischenablage kopieren

Screenshot des Anwendungsfensters der aktuellen Excel-Sitzung in die Zwischenablage kopieren

Screenshot des gesamten Bildschirmes in die Zwischenablage kopieren

To Top


Formatvorlagen "Hyperlink" und "Besuchter Hyperlink" einer Arbeitsmappe löschen

.Beschreibung
Sobald man einer Zelle einen Hyperlink hinzufügt, erstellt Microsoft Excel automatisch eine Formatvorlage namens "Hyperlink". Wenn Sie erstmals auf den Hyperlink klicken, wird eine weitere Formatvorlage "Besuchter Hyperlink" angelegt. Wenn Sie jedoch den Hyperlink entfernen, wird die Formatvorlage bzw. werden die Formatvorlagen nicht automatisch gelöscht.

Dieses Codebeispiel entfernt die beiden genannten Formatvorlagen aus der aktiven Arbeitsmappe.

.VBA-Code
Public Sub DeleteHyperlinkStyles()
  ActiveWorkbook.Styles("Hyperlink").Delete

  ActiveWorkbook.Styles("Besuchter Hyperlink").Delete
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Workbook-Objektes

 

Verwandte Codebeispiele

Prüfen, ob die Formatvorlagen "Hyperlink" und "Besuchter Hyperlink" in einer Arbeitsmappe existieren

To Top


Prüfen, ob die Formatvorlagen "Hyperlink" und "Besuchter Hyperlink" in einer Arbeitsmappe existieren

.Beschreibung
Mit dieser Prozedur wird überprüft, ob sich die beiden Formatvorlagen "Hyperlink" und "Besuchter Hyperlink" in einer Arbeitsmappe befinden. Im Beispiel wird die aktive Arbeitsmappe verwendet.

.VBA-Code
Public Sub CheckIfHyperlinkStylesExist()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Workbook-Objektes

 

Verwandte Codebeispiele

Formatvorlagen "Hyperlink" und "Besuchter Hyperlink" einer Arbeitsmape löschen

To Top


Druckbereich eines Arbeitsblattes festlegen/aufheben

.Beschreibung
In Microsoft Excel kann man via Menübefehl "Druckbereich" des Menüs "Datei" den Druckbereich eines Arbeitsblattes festlegen beziehungsweise aufheben. Die nachfolgenden Codebeispiele zeigen die verschiedenen Möglichkeiten.

» Codebeispiel #1: Legt den Zellbereich A1:C4 als Druckbereich für das aktive Arbeitsblatt fest.

» Codebeispiel #2: Legt den benannten Zellbereich "Mitarbeiter" als Druckbereich für das aktive Arbeitsblatt fest.

» Codebeispiel #3: Legt die Vereinigungsmenge (analog Union) der beiden Zellbereiche A1:C4 und E6:F10 als Druckbereich für das aktive Arbeitsblatt fest.

» Codebeispiel #4: Legt die Schnittmenge (analog Intersect) der beiden Zellbereiche A1:E7 und D4:F10 als Druckbereich für das aktive Arbeitsblatt fest.

» Codebeispiel #5: Legt den Zellbereich A1:C4 als Druckbereich für das Arbeitsblatt "Statistik" fest.

» Codebeispiel #6: Hebt den Druckbereich des aktiven Arbeitsblattes auf.

.VBA-Code #1
Public Sub SetPrintArea1()
  ActiveSheet.PageSetup.PrintArea = "A1:C4"
End Sub

.VBA-Code #2
Public Sub SetPrintArea2()
  ActiveSheet.PageSetup.PrintArea = "Mitarbeiter"
End Sub

.VBA-Code #3
Public Sub SetPrintArea3()
  ActiveSheet.PageSetup.PrintArea = "A1:C4,E6:F10"
End Sub

.VBA-Code #4
Public Sub SetPrintArea4()
  ActiveSheet.PageSetup.PrintArea = "A1:E7 D4:F10"
End Sub

.VBA-Code #5
Public Sub SetPrintArea5()
  Worksheets("Statistik").PageSetup.PrintArea = "A1:C4"
End Sub

.VBA-Code #6
Public Sub RemovePrintArea()
  ActiveSheet.PageSetup.PrintArea = ""
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Druckbereich eines Arbeitsblattes auf andere Arbeitsblätter übernehmen

To Top


Druckbereich eines Arbeitsblattes unter Berücksichtigung vorhandener Zeichnungsobjekte festlegen

.Beschreibung
Wenn man mit VBA den Druckbereich eines Tabellenblattes festlegen möchte, verwendet man gewöhnlich die UsedRange-Eigenschaft des Tabellenblattes, welche den benutzten Zellbereich darstellt. Das funktioniert ohne Probleme, so lange das Blatt keine Objekte enthält, die sich ganz oder teilweise ausserhalb des benutzten Zellbereiches befinden.

Diese Prozedur ermittelt den Druckbereich unter Berücksichtigung aller Objekte wie AutoFormen, Diagramme, Formular-Steuerelemente, ActiveX-Steuerelemente, eingebettete Dokumente und dergleichen.

.VBA-Code
Public Sub SetPrintArea()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Druckbereich eines Arbeitsblattes festlegen/aufheben

Druckbereich eines Arbeitsblattes basierend auf den vorhandenen Zeichnungsobjekten festlegen

Druckbereich eines Arbeitsblattes auf andere Arbeitsblätter übernehmen

To Top


Druckbereich eines Arbeitsblattes basierend auf den vorhandenen Zeichnungsobjekten festlegen

.Beschreibung
...

.VBA-Code #1
Public Sub SetPrintAreaForShapes1()
  Dim rngPrintArea As Range
  Dim rngRangeCheck As Range
  Dim intCounter As Integer
  With ActiveSheet
    Set rngPrintArea = .Range("A1")
    For intCounter = 1 To .Shapes.Count
      If .Shapes(intCounter).Type <> msoComment Then
        Set rngRangeCheck = Application.Intersect(.Range(rngPrintArea.Address), .Shapes(intCounter).BottomRightCell)
        If rngRangeCheck Is Nothing Then
          If .Shapes(intCounter).BottomRightCell.Row - rngPrintArea.Rows.Count > 0 Then
            Set rngPrintArea = rngPrintArea.Resize(.Shapes(intCounter).BottomRightCell.Row)
          End If
          If .Shapes(intCounter).BottomRightCell.Column - rngPrintArea.Columns.Count > 0 Then
            Set rngPrintArea = rngPrintArea.Resize(, .Shapes(intCounter).BottomRightCell.Column)
          End If
        End If
      End If
    Next intCounter
    If rngPrintArea.Cells.Count > 1 Then
      .PageSetup.PrintArea = rngPrintArea.Address
    End If
  End With
  Set rngRangeCheck = Nothing
  Set rngPrintArea = Nothing
End Sub

.VBA-Code #2
Public Sub SetPrintAreaForShapes2()
  Dim rngPrintArea As Range
  Dim rngRangeCheck As Range
  Dim intCounter As Integer
  With ActiveSheet
    Set rngPrintArea = .Range("A1")
    For intCounter = 1 To .Shapes.Count
      If .Shapes(intCounter).Type <> msoComment Then
        Set rngRangeCheck = Application.Intersect(.Range(rngPrintArea.Address), .Shapes(intCounter).BottomRightCell)
        If rngRangeCheck Is Nothing Then
          Set rngPrintArea = Application.Union(rngPrintArea, .Range("A1:" & .Shapes(intCounter).BottomRightCell.Address))
        End If
      End If
    Next intCounter
    If rngPrintArea.Cells.Count > 1 Then
      .PageSetup.PrintArea = rngPrintArea.Address
    End If
  End With
  Set rngRangeCheck = Nothing
  Set rngPrintArea = Nothing
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Druckbereich eines Arbeitsblattes festlegen/aufheben

Druckbereich eines Arbeitsblattes unter Berücksichtigung vorhandener Zeichnungsobjekte festlegen

Druckbereich eines Arbeitsblattes auf andere Arbeitsblätter übernehmen

To Top


Kopf-/Fusszeile eines Arbeitsblattes auf andere Arbeitsblätter übernehmen

.Beschreibung
Das Übernehmen der Kopf- bzw. Fusszeile eines bestimmten Blattes auf andere Blätter ist äusserst einfach.

.VBA-Code
Public Sub ApplyHeaderFooter()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Druckbereich eines Arbeitsblattes auf andere Arbeitsblätter übernehmen

To Top


Pfad einer Arbeitsmappe in die Kopf-/Fusszeile eines Arbeitsblattes eintragen

.Beschreibung
In den älteren Versionen von Microsoft Excel kann man nur den Dateinamen der Arbeitsmappe in die Kopf- bzw. Fusszeile eines Arbeitsblattes einfügen. Der vollständige Dateipfad steht nicht zur Verfügung.

.VBA-Code
Public Sub AddFilePathToHeaderFooter()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Kopf-/Fusszeile eines Arbeitsblattes auf andere Arbeitsblätter übernehmen

To Top


Prüfen, ob ein Drucker vorhanden ist

.Beschreibung
Dieses Codebeispiel überprüft, ob ein bestimmter Drucker vorhanden ist. Diese Information ist insbesondere dann wichtig, wenn Sie den aktiven Drucker anhand der ActivePrinter-Eigenschaft ändern möchten.

.VBA-Code
Public Sub CheckPrinterAvailable()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Port des aktuell verwendeten Druckers abfragen

Alle Codebeispiele von Themengebiet: Drucker/Drucken

To Top


Port des aktuell verwendeten Druckers abfragen

.Beschreibung
Dieses Codebeispiel gibt den Port des aktiven Druckers aus.

» Codebeispiel #1: VBA/Excel

» Codebeispiel #2: Visual Basic

.VBA-Code #1
Public Sub GetActivePrinterPort1()

End Sub

.VBA-Code #2
Public Sub GetActivePrinterPort2()
  MsgBox "Druckerport: " & Printer.Port
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

...

Alle Codebeispiele von Themengebiet: Drucker/Drucken

To Top


Fenster-Handle (hwnd) eines Steuerelementes ermitteln

.Beschreibung
Noch keine Lösung gefunden!

.VBA-Code
Public Sub GetWindowHandleOfObject()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Fenster-Handle (hwnd) eines Benutzerformulares ermitteln

Alle Codebeispiele von Themengebiet: Fenster

To Top


Ordner-Verknüpfung auf dem Windows Desktop erstellen

.Beschreibung
...

.VBA-Code
Public Sub CreateFolderShortcutOnWindowsDesktop()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Ordner-Verknüpfung im Windows-Startmenü erstellen

To Top


Ordner-Verknüpfung im Windows-Startmenü erstellen

.Beschreibung
Das Windows-Startmenü wird geöffnet, indem man auf die Schaltfläche "Start" der Windows Task-Leiste klickt. Diesem Menü lassen sich eigene Verknüpfungen hinzufügen, beispielsweise eine Verknüpfung zu einem Ordner.

Dieses Beispiel erstellt eine Verknüpfung zur Datei "Textdatei.txt", die sich im Verzeichnis "C:\Dateien" befindet. Als Arbeitsverzeichnis wird ebenfalls "C:\Dateien" verwendet und der Fensterstil "Normales Fenster" benutzt. Beachten Sie, dass der Verknüpfung eine globale Tastenkombination Strg+Alt+W zugewiesen wird (kann weggelassen werden). Der Pfad des Startmenüs, welches technisch gesehen nichts anderes als ein Ordner ist, wird mit der SpecialFolders-Eigenschaft ermittelt.

.VBA-Code
Public Sub CreateFolderShortcutInWindowsStartMenu()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Ordner-Verknüpfung auf dem Windows Desktop erstellen

Internet-Verknüpfung im Windows-Startmenü erstellen

Datei-Verknüpfung im Windows-Startmenü erstellen

To Top


Datei-Verknüpfung im Windows-Startmenü erstellen

.Beschreibung
Das Windows-Startmenü wird geöffnet, indem man auf die Schaltfläche "Start" der Windows Task-Leiste klickt. Diesem Menü lassen sich eigene Verknüpfungen hinzufügen, beispielsweise eine Verknüpfung zu einer Datei.

Dieses Beispiel erstellt eine Verknüpfung zur Datei "Textdatei.txt", die sich im Verzeichnis "C:\Dateien" befindet. Als Arbeitsverzeichnis wird ebenfalls "C:\Dateien" verwendet und der Fensterstil "Normales Fenster" benutzt. Beachten Sie, dass der Verknüpfung eine globale Tastenkombination Strg+Alt+W zugewiesen wird (kann weggelassen werden). Der Pfad des Startmenüs, welches technisch gesehen nichts anderes als ein Ordner ist, wird mit der SpecialFolders-Eigenschaft ermittelt.

.VBA-Code
Public Sub CreateFileShortcutInWindowsStartMenu()
  Dim objWSHShell As Object
  Dim objWSHShortcut As Object
  Set objWSHShell = CreateObject("WScript.Shell")
  Set objWSHShortcut = objWSHShell.CreateShortcut(objWSHShell.SpecialFolders("Startmenu") & "\Dateilink.lnk")
  With objWSHShortcut
    .TargetPath = "C:\Dateien\Textdatei.txt"
    .Hotkey = "ALT+CTRL+W"
    .WorkingDirectory = "C:\Dateien"
    .WindowStyle = 1   '1=Normales Fenster
    .Save
  End With
  Set objWSHShortcut = Nothing
  Set objWSHShell = Nothing
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Ordner-Verknüpfung im Windows-Startmenü erstellen

Internet-Verknüpfung im Windows-Startmenü erstellen

Systemweite Tastenkombination für eine Datei-Verknüpfung erstellen

To Top


Datei-Verknüpfung im Eigene Dateien-Ordner erstellen

.Beschreibung
Dieses Beispiel zeigt, wie man dem Ordner "Eigene Dateien" eine neue Datei-Verknüpfung hinzufügen kann.

.VBA-Code
Public Sub CreateFileShortcutInMyDocumentsFolder()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Datei-Verknüpfung im Windows-Startmenü erstellen

To Top


Internet-Verknüpfung im Windows-Startmenü erstellen

.Beschreibung
Dieses Beispiel zeigt, wie man dem Windows-Startmenü eine neue Internet-Verknüpfung hinzufügen kann.

.VBA-Code
Public Sub CreateWebShortcutInWindowsStartMenu()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Datei-Verknüpfung im Windows-Startmenü erstellen

Ordner-Verknüpfung im Windows-Startmenü erstellen

To Top


Systemweite Tastenkombination für eine Datei-Verknüpfung erstellen

.Beschreibung
Windows unterstützt Tastenkombinationen, die systemweit erkannt werden. Dazu muss man lediglich eine Tastenkombination einer Datei-Verknüpfung im Windows-Startmenü zuweisen.

.VBA-Code
Public Sub CreateGlobalShortcut()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Datei-Verknüpfung im Windows-Startmenü erstellen

Ordner-Verknüpfung im Windows-Startmenü erstellen

Internet-Verknüpfung im Windows-Startmenü erstellen

Alle Codebeispiele von Themengebiet: Taste

To Top


AutoFilter vor dem Speichern einer Arbeitsmappe ausschalten

.Beschreibung
Es gibt zwei gute Gründe, weshalb man einen AutoFilter vor dem Speichern der Arbeitsmappe ausschalten sollte:

1. Die Arbeitsmappendatei ist kleiner. Alle Datenspalten besitzen beim AutoFilter einen DropDown-Pfeil. Jeder DropDown-Pfeil ist ein kleines grafisches Objekt, das in der xls-Datei gespeichert wird und zirka 300 Bytes Platz beansprucht. Wenn beispielsweise alle 256 Spalten eines Tabellenblattes gefiltert werden können, ist die Exceldatei etwa 76 KB grösser als ohne AutoFilter (256 Spalten × 300 Bytes).

2. Die Arbeitsmappe wird schneller geöffnet. Beim Öffnen einer Mappe mit AutoFilter wird zuerst die Tabelle geladen und dann der AutoFilter angewendet.

...

.VBA-Code
Public Sub DeactivateAutoFilter()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

To Top


Zusätzliche Mappenfenster vor dem Speichern einer Arbeitsmappe schliessen

.Beschreibung
Beim Öffnen einer Arbeitsmappe werden so viele Mappenfenster geöffnet, wie beim letzten Speichern der Mappe vorhanden waren. Mit diesem Programmcode werden alle zusätzlichen Fenster der aktiven Arbeitsmappe geschlossen.

.VBA-Code
Public Sub CloseAdditionalWorkbookWindows()
  Dim intCounter As Integer
  For intCounter = 1 To ActiveWorkbook.Windows.Count - 1
    ActiveWorkbook.Windows(1).Close
  Next intCounter
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Schliessen eines Arbeitsmappenfensters verhindern

Arbeitsmappe anlegen und Mappenfenster sofort ausblenden

To Top


Datei als eingebettetes Objekt in ein Arbeitsblatt einfügen

.Beschreibung
In Microsoft Excel werden Objekte anhand des Menübefehls Einfügen/Objekt in ein Arbeitsblatt eingefügt. Das lässt sich auch mit VBA-Code machen.

.VBA-Code
Public Sub InsertOLEObject()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Datei als eingebettetes verknüpftes Objekt in ein Arbeitsblatt einfügen

WordArt-Objekt in ein Arbeitsblatt einfügen

Bilddatei in ein Arbeitsblatt einfügen

To Top


Datei als eingebettetes verknüpftes Objekt in ein Arbeitsblatt einfügen

.Beschreibung
In Microsoft Excel werden Objekte anhand des Menübefehls Einfügen/Objekt in ein Arbeitsblatt eingefügt. Das lässt sich auch mit VBA-Code machen.

.VBA-Code
Public Sub InsertLinkedOLEObject()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Datei als eingebettetes Objekt in ein Arbeitsblatt einfügen

To Top


WordArt-Objekt in ein Arbeitsblatt einfügen

.Beschreibung
Dieses Codebeispiel zeigt, wie man ein WordArt-Objekt in ein Arbeitsblatt einfügen kann.

AddTextEffect-Methode des Shape-Objektes.

.VBA-Code
Public Sub InsertWordArtObject()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Bilddatei in ein Arbeitsblatt einfügen

To Top


Bilddatei in ein Arbeitsblatt einfügen

.Beschreibung
Mit diesem Codebeispiel wird eine Bilddatei in ein Arbeitsblatt eingefügt.

.VBA-Code
Public Sub InsertPictureObject()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

WordArt-Objekt in ein Arbeitsblatt einfügen

To Top


Prüfen, ob eine Schriftart installiert ist

.Beschreibung
Dieses Codebeispiel überprüft, ob eine bestimmte Schriftart auf dem Computer vorhanden ist.

vbTextCompare, damit Gross-/Kleinschreibung nicht berücksichtigt wird.

Die Konstante strFontname (Prozedur TestCall) enthält die zu überprüfende Schriftart. Im Beispiel wird "Verdana" verwendet.

.VBA-Code
Public Function CheckFont(ByVal strFont As String) As Boolean
  Dim intFonts As Integer
  Dim intResult As Integer
  Dim objControl As CommandBarComboBox
  strFont = Trim$(strFont)
  Set objControl = Application.CommandBars.FindControl(Id:=1728)
  For intFonts = 0 To objControl.ListCount - 1
    intResult = StrComp(strFont, objControl.List(intFonts + 1), vbTextCompare)
    If intResult = 0 Then
      CheckFont = True
      Exit Function
    ElseIf intResult = -1 Then
      CheckFont = False
      Exit Function
    End If
  Next intFonts
  Set objControl = Nothing
End Function

'*** Aufruf ***
Sub TestCall()
  Const strFontname As String = "Verdana"
  If CheckFont(strFontname) = True Then
    MsgBox "Schriftart '" & strFontname & "' ist vorhanden.", vbInformation
  Else
    MsgBox "Schriftart '" & strFontname & "' ist nicht vorhanden.", vbInformation
  End If
End Sub

Verwandte Codebeispiele

Installierte Schriften auflisten

To Top


Prüfen, ob über den Datei öffnen-Dialog eine Arbeitsmappe geöffnet wurde

.Beschreibung
Immer wenn man dem Benutzer die Möglichkeit anbietet, via Dialogfenster "Datei öffnen" eine Arbeitsmappendatei auszuwählen und zu öffnen, sollte man unbedingt überprüfen, ob daraufhin wirklich eine Arbeitsmappe geöffnet wurde. Allein die Tatsache, dass der Benutzer eine (Arbeitsmappen-)Datei selektiert und dann die Öffnen-Schaltfläche geklickt hat, bedeutet nämlich noch nicht, dass die Arbeitsmappe geöffnet und in Form eines Mappenfensters in Microsoft Excel sichtbar gemacht werden konnte.

.VBA-Code
Public Sub CheckFileOpen()

End Sub

To Top


Anführungszeichen in einem Dateipfad entfernen

.Beschreibung
Dateipfade können unter Umständen am Anfang und Ende je ein Anführungszeichen (") besitzen. Dies ist insbesondere der Fall, wenn der Pfad Leerzeichen enthält.

Mit dieser Prozedur werden die Anführungszeichen entfernt.

.VBA-Code
Public Sub RemoveHyphen()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Hochkommas am Anfang und Ende eines Dateipfades entfernen

To Top


Hochkommas am Anfang und Ende eines Dateipfades entfernen

.Beschreibung
...

.VBA-Code
Public Sub RemoveLeadingAndTrailingHyphen()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Anführungszeichen in einem Dateipfad entfernen

To Top


Dokument-Eigenschaft einer geschlossenen Datei ändern

.Beschreibung
Bei einer geschlossenen Dokument-Datei können folgende Dokument-Eigenschaften geändert werden (Liste alphabetisch sortiert):
- Autor (Author)
- Kategorie (Category)
- Kommentar (Comments)
- Firma (Company)
- Stichwörter (Keywords)
- Manager (Manager)
- Thema (Subject)
- Titel (Title)

- Zuletzt gespeichert von (LastEditedBy)

- Präsentationsformat (PresentationFormat)

 

.VBA-Code
Public Sub ModifyDocumentProperty()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Benutzerdefinierte Dokument-Eigenschaft einer geschlossenen Datei ändern

To Top


Benutzerdefinierte Dokument-Eigenschaft einer geschlossenen Datei ändern

.Beschreibung
Das Entfernen einer benutzerdefinierten Dokument-Eigenschaft einer geschlossenen Dokument-Datei...

.VBA-Code
Public Sub ModifyCustomDocumentProperty()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Dokument-Eigenschaft einer geschlossenen Datei ändern

Benutzerdefinierte Dokument-Eigenschaft einer geschlossenen Datei löschen

To Top


Benutzerdefinierte Dokument-Eigenschaft einer geschlossenen Datei löschen

.Beschreibung
In diesem Beispiel wird angenommen, dass die betroffene Datei geschlossen, d.h. nicht in Microsoft Excel geöffnet ist. Das Entfernen einer benutzerdefinierten Dokument-Eigenschaft einer geschlossenen Dokument-Datei erfolgt mittels Remove-Methode.

.VBA-Code #1
Public Sub DeleteCustomDocumentProperty1()

End Sub

.VBA-Code #2
Public Sub DeleteCustomDocumentProperty2()
  CreateObject("DSOleFile.PropertyReader").GetDocumentProperties("C:\Daten\EineMappe.xls"). _

     CustomProperties("Ablage").Remove
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Benutzerdefinierte Dokument-Eigenschaft einer Arbeitsmappe löschen

To Top


Benutzerdefinierte Dokument-Eigenschaft einer Arbeitsmappe löschen

.Beschreibung
...

.VBA-Code
Public Sub DeleteCustomDocumentProperty()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Benutzerdefinierte Dokument-Eigenschaft einer geschlossenen Datei löschen

To Top


Datei-Verknüpfung im Favoriten-Ordner löschen

.Beschreibung
Dieses Codebeispiel zeigt, wie man eine vorhandene Datei-Verknüpfung im Favoriten-Ordner löschen kann.

.VBA-Code
Public Sub DeleteLinkInFavoritesFolder()

End Sub

Weitere Informationen

VBA-Spezialthema: Windows Script Host (WSH)

 

Verwandte Codebeispiele

Datei-Verknüpfung im Favoriten-Ordner erstellen

Datei-Verknüpfung im 'Senden an'-Menü des Windows Explorers löschen

To Top


Datei-Verknüpfung im 'Senden an'-Menü des Windows Explorers löschen

.Beschreibung
Wenn man im Windows Explorer eine Datei markiert und dann die rechte Maustaste drückt, erscheint ein Menü, welches unter anderem das Menüelement 'Senden an' enthält. Wählt man dieses aus, wird eine Liste mit den vorhandenen Zielen angezeigt, an die die Datei gesendet werden kann. Jedes Ziel ist nichts anderes als eine Datei-Verknüpfung, die im Unterordner "Senden an" des Profil-Ordners des aktuellen Benutzers gespeichert ist.

Dieses Codebeispiel zeigt, wie man eine vorhandene Datei-Verknüpfung im 'Senden an'-Menü beziehungsweise in dessen Ordner löschen kann. Als Beispiel wird die Verknüpfung "Editor" verwendet. Da Verknüpfungen immer mit der Dateinamenerweiterung "lnk" angegeben werden müssen, ist die zu löschende Datei-Verknüpfung "Editor.lnk".

.VBA-Code
Public Sub DeleteLinkInSendToFolder()
  Const strFilename As String = "Editor.lnk"
  Dim objWSHShell As Object
  Dim strSendToFolder As String
  Set objWSHShell = CreateObject("WScript.Shell")
  strSendToFolder = objWSHShell.SpecialFolders("sendto")
  If Dir(strSendToFolder & "\" & strFilename, vbHidden) <> "" Then
    Kill strSendToFolder & "\" & strFilename
    MsgBox "Die Datei '" & strFilename & " wurde gelöscht.", vbInformation
  Else
    MsgBox "Im Senden an-Menü existiert keine Datei '" & strFilename & "!", vbExclamation
  End If
  Set objWSHShell = Nothing
End Sub

Weitere Informationen

VBA-Spezialthema: Windows Script Host (WSH)

 

Verwandte Codebeispiele

Datei-Verknüpfung im Favoriten-Ordner löschen

Verknüpfung zu einer Programmdatei im 'Senden an'-Menü des Windows Explorers erstellen

Dateien des 'Senden an'-Menüs des Windows Explorers auflisten

To Top


Dateien des 'Senden an'-Menüs des Windows Explorers auflisten

.Beschreibung
Dieser VBA-Programmcode erstellt eine Liste der Dateien beziehungsweise Datei-Verknüpfungen des 'Senden an'-Menüs des Windows Explorers. Die Liste wird auf einem neuen Arbeitsblatt der aktiven Arbeitsmappe erstellt.

.VBA-Code
Public Sub ListFilesInSendToFolder()

End Sub

Weitere Informationen

VBA-Spezialthema: Windows Script Host (WSH)

 

Verwandte Codebeispiele

Eigenes 'Senden an'-Menü bauen

Verknüpfung zu einer Programmdatei im 'Senden an'-Menü des Windows Explorers erstellen

Datei-Verknüpfung im 'Senden an'-Menü des Windows Explorers löschen

To Top


Eigenes 'Senden an'-Menü bauen

.Beschreibung
...

Nachbauen des 'Senden an'-Menüs.

Der VBA-Code ist ausschliesslich für Visual Basic (Version 4.0 bis 6.0).

 

Vorbereitung:

- Form hinzufügen.

- Menü mnuSendToParentMenu erstellen, welches ein Untermenü mnuSendToMenu enthält.

- Im Untermenü mnuSendToMenu 15 Menübefehle mit Name mnuSendToLink mit Index 0 bis 15 erstellen.

KontextMenü mnuSendToParentMenu
Senden an (Leer) mnuSendToMenu mnuSendToLink(0)
(Leer) mnuSendToLink(1)
(Leer) mnuSendToLink(2)
... ...
(Leer) mnuSendToLink(14)

 

.VBA-Code
Private Sub mnuSendToParentMenu_Click()
  Dim strSendToFolder As String
  Dim intCounter As Integer
  Dim strFile As String
  Dim strLink As String
  Dim intChar As Integer
  Dim intCharsToRemove As Integer

  'Alle 15 Submenü-Elemente des Senden an-Menübefehls zurücksetzen
  For intCounter = 14 To 1 Step -1   'Nicht To 0, weil mindestens ein Element sichtbar sein muss
    mnuSendToLink(intCounter).Visible = False
    mnuSendToLink(intCounter).Caption = ""
    mnuSendToLink(intCounter).Tag = ""
  Next intCounter
  mnuSendToLink(0).Visible = True

  mnuSendToLink(0).Caption = "(Leer)"
  mnuSendToLink(0).Tag = ""

  strSendToFolder = CreateObject("WScript.Shell").SpecialFolders("sendto")
  strFile = Dir(strSendToFolder & "\*.*")
  intCounter = 0
  Do While strFile <> ""
    If strFile <> "" Then
      intCharsToRemove = 0
      For intChar = Len(strFile) To 1 Step -1
        If Mid$(strFile, intChar, 1) = "." Then
          intCharsToRemove = Len(strFile) - intChar
          Exit For
        End If
      Next intChar
      strLink = Left$(strFile, Len(strFile) - intCharsToRemove - 1)
      mnuSendToLink(intCounter).Visible = True

      mnuSendToLink(intCounter).Caption = strLink
      mnuSendToLink(intCounter).Tag = strFile
    Else
      Exit Do
    End If
    intCounter = intCounter + 1
    If intCounter > 14 Then Exit Do
    strFile = Dir()
  Loop
End Sub

Private Sub mnuSendToLink_Click(Index As Integer)
  Dim strFileToSend As String
  strFileToSend = "C:\Daten\EineDatei.txt"
  CreateObject("WScript.Shell").Run CreateObject("WScript.Shell").SpecialFolders("sendto") & _

      "\" & mnuSendToLink(Index).Tag & " " & Chr$(34) & strFileToSend & Chr$(34)
End Sub

Weitere Informationen

VBA-Spezialthema: Windows Script Host (WSH)

 

Verwandte Codebeispiele

Dateien des 'Senden an'-Menüs des Windows Explorers auflisten

Verknüpfung zu einer Programmdatei im 'Senden an'-Menü des Windows Explorers erstellen

Datei-Verknüpfung im 'Senden an'-Menü des Windows Explorers löschen

To Top


Prüfen, ob der Benutzer die Berechtigung 'Vollzugriff' für eine bestimmte Datei besitzt

.Beschreibung
Mit diesem Programmcode können Sie überprüfen, ob der aktuelle Windows-Benutzer sämtliche Berechtigungen (Vollzugriff) für eine bestimmte Datei besitzt.

Wenn das Dateisystem oder das angesprochene Laufwerk keine Benutzer-Berechtigungen unterstützt, wird davon ausgegangen, dass der Benutzer uneingeschränkten Zugriff besitzt.

.VBA-Code
Public Sub CheckRightsFullAccess()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Prüfen, ob der Benutzer die Berechtigung 'Lesen' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Schreiben' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Löschen' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Ausführen' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Besitz übernehmen' für eine bestimmte Datei besitzt

Alle Codebeispiele von Themengebiet: Berechtigung

To Top


Prüfen, ob der Benutzer die Berechtigung 'Lesen' für eine bestimmte Datei besitzt

.Beschreibung
Mit diesem Programmcode können Sie überprüfen, ob der aktuelle Windows-Benutzer die Datei-Berechtigungen 'Lesen' für eine bestimmte Datei besitzt. Es wird ausschliesslich diese Berechtigung kontrolliert. Die Lesen-Berechtigung regelt das Lesen/Öffnen einer Datei. Wenn diese Berechtigung fehlt, können weder Dateiinhalt noch Dokument-Eigenschaften (zum Beispiel Titel, Thema, Autor etc. bei einer Microsoft Excel-Arbeitsmappe) gelesen werden. Eine Arbeitsmappendatei kann ohne die Lesen-Berechtigung nicht mit Microsoft Excel geöffnet werden. Bei anderen Dateitypen, beispielsweise bei ausführbaren Dateien, können die Versionsinformationen nicht angezeigt werden.

Wenn das Dateisystem oder das angesprochene Laufwerk keine Benutzer-Berechtigungen unterstützt, wird davon ausgegangen, dass der Benutzer uneingeschränkten Zugriff besitzt.

.VBA-Code
Public Sub CheckRightsRead()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Prüfen, ob der Benutzer die Berechtigung 'Vollzugriff' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Schreiben' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Löschen' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Ausführen' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Besitz übernehmen' für eine bestimmte Datei besitzt

Alle Codebeispiele von Themengebiet: Berechtigung

To Top


Prüfen, ob der Benutzer die Berechtigung 'Schreiben' für eine bestimmte Datei besitzt

.Beschreibung
Mit diesem Programmcode können Sie überprüfen, ob der aktuelle Windows-Benutzer die Datei-Berechtigungen 'Schreiben' für eine bestimmte Datei besitzt. Es wird ausschliesslich diese Berechtigung kontrolliert. Die Schreiben-Berechtigung regelt das Ändern einer Datei. Wenn diese Berechtigung fehlt, kann die Datei zwar umbenannt, aber weder ihr Inhalt noch die Datei-Attribute geändert werden. Wenn bei einer Arbeitsmappendatei die Lesen- aber keine Schreiben-Berechtigung vorhanden ist, wird die Arbeitsmappe schreibgeschützt geöffnet.

Wenn das Dateisystem oder das angesprochene Laufwerk keine Benutzer-Berechtigungen unterstützt, wird davon ausgegangen, dass der Benutzer uneingeschränkten Zugriff besitzt.

.VBA-Code
Public Sub CheckRightsWrite()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Prüfen, ob der Benutzer die Berechtigung 'Vollzugriff' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Lesen' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Löschen' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Ausführen' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Besitz übernehmen' für eine bestimmte Datei besitzt

Alle Codebeispiele von Themengebiet: Berechtigung

To Top


Prüfen, ob der Benutzer die Berechtigung 'Löschen' für eine bestimmte Datei besitzt

.Beschreibung
Mit diesem Programmcode können Sie überprüfen, ob der aktuelle Windows-Benutzer die Datei-Berechtigungen 'Löschen' für eine bestimmte Datei besitzt. Es wird ausschliesslich diese Berechtigung kontrolliert. Die Löschen-Berechtigung bestimmt, ob der Benutzer die Datei löschen kann.

Wenn das Dateisystem oder das angesprochene Laufwerk keine Benutzer-Berechtigungen unterstützt, wird davon ausgegangen, dass der Benutzer uneingeschränkten Zugriff besitzt.

.VBA-Code
Public Sub CheckRightsDelete()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Prüfen, ob der Benutzer die Berechtigung 'Vollzugriff' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Lesen' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Schreiben' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Ausführen' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Besitz übernehmen' für eine bestimmte Datei besitzt

Alle Codebeispiele von Themengebiet: Berechtigung

To Top


Prüfen, ob der Benutzer die Berechtigung 'Ausführen' für eine bestimmte Datei besitzt

.Beschreibung
Mit diesem Programmcode können Sie überprüfen, ob der aktuelle Windows-Benutzer die Datei-Berechtigungen 'Ausführen' für eine bestimmte Datei besitzt. Es wird ausschliesslich diese Berechtigung kontrolliert. Die Ausführen-Berechtigung legt fest, ob der Benutzer die (Programm-)Datei ausführen kann. Bei nicht vorhandener Berechtigung erscheint beim Versuch, die Datei auszuführen, die Fehlermeldung "Der Zugriff auf das angegebene Gerät, den Pfad oder die Datei wurde verweigert".

Wenn das Dateisystem oder das angesprochene Laufwerk keine Benutzer-Berechtigungen unterstützt, wird davon ausgegangen, dass der Benutzer uneingeschränkten Zugriff besitzt.

.VBA-Code
Public Sub CheckRightsExecute()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Prüfen, ob der Benutzer die Berechtigung 'Vollzugriff' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Lesen' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Schreiben' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Löschen' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Besitz übernehmen' für eine bestimmte Datei besitzt

Alle Codebeispiele von Themengebiet: Berechtigung

To Top


Prüfen, ob der Benutzer die Berechtigung 'Besitz übernehmen' für eine bestimmte Datei besitzt

.Beschreibung
Mit diesem Programmcode können Sie überprüfen, ob der aktuelle Windows-Benutzer die Datei-Berechtigungen 'Besitz übernehmen' für eine bestimmte Datei besitzt. Es wird ausschliesslich diese Berechtigung kontrolliert. Die Besitz übernehmen-Berechtigung bestimmt, ob der aktuelle Benutzer den Besitz einer Datei übernehmen kann.

Wenn das Dateisystem oder das angesprochene Laufwerk keine Benutzer-Berechtigungen unterstützt, wird davon ausgegangen, dass der Benutzer uneingeschränkten Zugriff besitzt.

.VBA-Code
Public Sub CheckRightsChangeOwner()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Prüfen, ob der Benutzer die Berechtigung 'Vollzugriff' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Lesen' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Schreiben' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Löschen' für eine bestimmte Datei besitzt

Prüfen, ob der Benutzer die Berechtigung 'Ausführen' für eine bestimmte Datei besitzt

Alle Codebeispiele von Themengebiet: Berechtigung

To Top


Dateien eines Ordners mit Datei-Berechtigungen des Benutzers auflisten

.Beschreibung
Die beiden hier vorgestellten Codebeispiele erstellen eine Liste der Dateien eines Ordners. Zu jeder Datei wird angegeben, welche Datei-Berechtigungen der aktuelle Benutzer besitzt.

 

Berechtigung Buchstabe Konstante
Vollzugriff F FILE_ALL_ACCESS
Lesen R FILE_GENERIC_READ
Schreiben W FILE_GENERIC_WRITE
Ausführen X FILE_GENERIC_EXECUTE
Löschen D DELETE
Besitz übernehmen O WRITE_OWNER

 

 

.VBA-Code #1
Public Sub ListFilesWithAccessRights1()
  Dim objFolder As Object
  Dim objFile As Object
  Dim wksSheet As Worksheet
  Dim intCounter As Integer
  Set objFolder = CreateObject("Scripting.FileSystemObject").GetFolder("C:\Daten")
  If objFolder.Files.Count = 0 Then
    MsgBox "Der Ordner enthält keine Dateien.", vbInformation
    Set objFolder = Nothing
    Exit Sub
  End If
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  With wksSheet
    .Range("A1").Value = "Dateien von Ordner " & objFolder.Path
    .Range("A1").Font.Bold = True
    .Range("A3:B3").Value = Array("Datei", "Berechtigungen")
    .Range("A3:B3").Font.Bold = True
  End With
  intCounter = 3
  For Each objFile In objFolder.Files
    intCounter = intCounter + 1
    With wksSheet
      .Cells(intCounter, 1).Value = objFile.Name
      If CheckFileAccess(objFile.Path, FILE_ALL_ACCESS) = FILE_ALL_ACCESS Then
        .Cells(intCounter, 2).Value = "F"
      Else
        If CheckFileAccess(objFile.Path, FILE_GENERIC_READ) = FILE_GENERIC_READ Then
          .Cells(intCounter, 2).Value = .Cells(intCounter, 2).Value & "R"
        End If
        If CheckFileAccess(objFile.Path, FILE_GENERIC_WRITE) = FILE_GENERIC_WRITE Then
          .Cells(intCounter, 2).Value = .Cells(intCounter, 2).Value & "W"
        End If
        If CheckFileAccess(objFile.Path, FILE_GENERIC_EXECUTE) = FILE_GENERIC_EXECUTE Then
          .Cells(intCounter, 2).Value = .Cells(intCounter, 2).Value & "X"
        End If
        If CheckFileAccess(objFile.Path, DELETE) = DELETE Then
          .Cells(intCounter, 2).Value = .Cells(intCounter, 2).Value & "D"
        End If
        If CheckFileAccess(objFile.Path, WRITE_OWNER) = WRITE_OWNER Then
          .Cells(intCounter, 2).Value = .Cells(intCounter, 2).Value & "O"
        End If
      End If
    End With
  Next
  wksSheet.Columns("A:B").AutoFit
  Set objFolder = Nothing
  Set wksSheet = Nothing
End Sub

.VBA-Code #2
Public Sub ListFilesWithAccessRights2()
  Dim objFolder As Object
  Dim objFile As Object
  Dim wksSheet As Worksheet
  Dim intCounter As Integer
  Set objFolder = CreateObject("Scripting.FileSystemObject").GetFolder("C:\Daten")
  If objFolder.Files.Count = 0 Then
    MsgBox "Der Ordner enthält keine Dateien.", vbInformation
    Set objFolder = Nothing
    Exit Sub
  End If
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  With wksSheet
    .Range("A1").Value = "Dateien von Ordner " & objFolder.Path
    .Range("A1").Font.Bold = True
    .Range("A3:G3").Value = Array("Datei", "Vollzugriff (F)", "Lesen (R)", "Schreiben (W)", _

        "Ausführen (X)", "Löschen (D)", "Besitz übernehmen (O)")
    .Range("A3:G3").Font.Bold = True
  End With
  intCounter = 3
  For Each objFile In objFolder.Files
    intCounter = intCounter + 1
    With wksSheet
      .Cells(intCounter, 1).Value = objFile.Name
      .Cells(intCounter, 2).Value = CBool(CheckFileAccess(objFile.Path, FILE_ALL_ACCESS) = FILE_ALL_ACCESS)
      .Cells(intCounter, 3).Value = CBool(CheckFileAccess(objFile.Path, FILE_GENERIC_READ) = FILE_GENERIC_READ)
      .Cells(intCounter, 4).Value = CBool(CheckFileAccess(objFile.Path, FILE_GENERIC_WRITE) = FILE_GENERIC_WRITE)
      .Cells(intCounter, 5).Value = CBool(CheckFileAccess(objFile.Path, FILE_GENERIC_EXECUTE) = FILE_GENERIC_EXECUTE)
      .Cells(intCounter, 6).Value = CBool(CheckFileAccess(objFile.Path, DELETE) = DELETE)
      .Cells(intCounter, 7).Value = CBool(CheckFileAccess(objFile.Path, WRITE_OWNER) = WRITE_OWNER)
    End With
  Next
  wksSheet.Columns("A:G").AutoFit
  Set objFolder = Nothing
  Set wksSheet = Nothing

End Sub

To Top


Unterordner eines Ordners mit Verzeichnis-Berechtigungen des Benutzers auflisten

.Beschreibung
Die beiden hier vorgestellten Codebeispiele erstellen eine Liste der in einem bestimmten Ordner enthaltenen Unterordner, und geben zu jedem Unterordner die Berechtigungen des aktuellen Benutzers an.

 

.VBA-Code
Public Sub ListFoldersWithAccessRights()

End Sub

To Top


Datei-Berechtigungen des Benutzers für eine bestimmte Datei abfragen

.Beschreibung
Beschreibung folgt.

Abfragen, welche Berechtigungen der angemeldete Benutzer für eine bestimmte Datei besitzt.

Wenn
- das Betriebssystem nicht vom Typ Windows NT ist (d.h. Windows NT 4.0, Windows 2000 oder Windows XP) oder
- das Dateisystem des angesprochenen Laufwerkes keine Berechtigungen unterstützt oder
- für die Datei keine Security-Informationen vorhanden sind,
dann gibt die Funktion CheckFileAccess generell Wahr (bzw. True) zurück, weil der Benutzer uneingeschränkten Zugriff auf die Datei besitzt.

 

Diese Berechtigungen können für Dateien abgefragt werden:

Berechtigung Buchstabe Konstante
Lesen R FILE_GENERIC_READ
Schreiben W FILE_GENERIC_WRITE
Ausführen X FILE_GENERIC_EXECUTE
Löschen D DELETE
Berechtigungen ändern P WRITE_DAC
Besitz übernehmen O WRITE_OWNER
Vollzugriff - FILE_ALL_ACCESS

 

.Autor
Sergey Merzlikin (Anpassungen durch Philipp von Wartburg)

.VBA-Code
'Deklarationsbereich
'''Desired access rights constants
Public Const MAXIMUM_ALLOWED As Long = &H2000000
Public Const DELETE As Long = &H10000
Public Const READ_CONTROL As Long = &H20000
Public Const WRITE_DAC As Long = &H40000
Public Const WRITE_OWNER As Long = &H80000
Public Const SYNCHRONIZE As Long = &H100000
Public Const STANDARD_RIGHTS_READ As Long = READ_CONTROL
Public Const STANDARD_RIGHTS_WRITE As Long = READ_CONTROL
Public Const STANDARD_RIGHTS_EXECUTE As Long = READ_CONTROL
Public Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Public Const FILE_READ_DATA As Long = &H1
Public Const FILE_LIST_DIRECTORY As Long = &H1
Public Const FILE_ADD_FILE As Long = &H2
Public Const FILE_WRITE_DATA As Long = &H2
Public Const FILE_CREATE_PIPE_INSTANCE As Long = &H4
Public Const FILE_ADD_SUBDIRECTORY As Long = &H4
Public Const FILE_APPEND_DATA As Long = &H4
Public Const FILE_READ_EA As Long = &H8
Public Const FILE_READ_PROPERTIES As Long = FILE_READ_EA
Public Const FILE_WRITE_EA As Long = &H10
Public Const FILE_WRITE_PROPERTIES As Long = FILE_WRITE_EA
Public Const FILE_EXECUTE As Long = &H20
Public Const FILE_TRAVERSE As Long = &H20
Public Const FILE_DELETE_CHILD As Long = &H40
Public Const FILE_READ_ATTRIBUTES As Long = &H80
Public Const FILE_WRITE_ATTRIBUTES As Long = &H100
Public Const FILE_GENERIC_READ As Long = (STANDARD_RIGHTS_READ _
    Or FILE_READ_DATA Or FILE_READ_ATTRIBUTES Or FILE_READ_EA Or SYNCHRONIZE)
Public Const FILE_GENERIC_WRITE As Long = (STANDARD_RIGHTS_WRITE _
    Or FILE_WRITE_DATA Or FILE_WRITE_ATTRIBUTES _
    Or FILE_WRITE_EA Or FILE_APPEND_DATA Or SYNCHRONIZE)
Public Const FILE_GENERIC_EXECUTE As Long = (STANDARD_RIGHTS_EXECUTE _
    Or FILE_READ_ATTRIBUTES Or FILE_EXECUTE Or SYNCHRONIZE)
Public Const FILE_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED _
    Or SYNCHRONIZE Or &H1FF&)
Public Const GENERIC_READ As Long = &H80000000
Public Const GENERIC_WRITE As Long = &H40000000
Public Const GENERIC_EXECUTE As Long = &H20000000
Public Const GENERIC_ALL As Long = &H10000000

'''Types, constants and functions to work with access rights
Public Const OWNER_SECURITY_INFORMATION As Long = &H1
Public Const GROUP_SECURITY_INFORMATION As Long = &H2
Public Const DACL_SECURITY_INFORMATION As Long = &H4
Public Const TOKEN_QUERY As Long = 8
Public Const SecurityImpersonation As Integer = 3
Public Const ANYSIZE_ARRAY = 1
Public Type GENERIC_MAPPING
  GenericRead As Long
  GenericWrite As Long
  GenericExecute As Long
  GenericAll As Long
End Type
Public Type LUID
  LowPart As Long
  HighPart As Long
  End Type
Public Type LUID_AND_ATTRIBUTES
  pLuid As LUID
  Attributes As Long
End Type
Public Type PRIVILEGE_SET
  PrivilegeCount As Long
  Control As Long
  Privilege(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Public Declare Function GetFileSecurity Lib "advapi32.dll" _
    Alias "GetFileSecurityA" (ByVal lpFileName As String, _
    ByVal RequestedInformation As Long, pSecurityDescriptor As Byte, _
    ByVal nLength As Long, lpnLengthNeeded As Long) As Long
Public Declare Function AccessCheck Lib "advapi32.dll" _
    (pSecurityDescriptor As Byte, ByVal ClientToken As Long, _
    ByVal DesiredAccess As Long, GenericMapping As GENERIC_MAPPING, _
    PrivilegeSet As PRIVILEGE_SET, PrivilegeSetLength As Long, _
    GrantedAccess As Long, Status As Long) As Long
Public Declare Function ImpersonateSelf Lib "advapi32.dll" _
    (ByVal ImpersonationLevel As Integer) As Long
Public Declare Function RevertToSelf Lib "advapi32.dll" () As Long
Public Declare Sub MapGenericMask Lib "advapi32.dll" (AccessMask As Long, _
    GenericMapping As GENERIC_MAPPING)
Public Declare Function OpenThreadToken Lib "advapi32.dll" _
    (ByVal ThreadHandle As Long, ByVal DesiredAccess As Long, _
    ByVal OpenAsSelf As Long, TokenHandle As Long) As Long
Public Declare Function GetCurrentThread Lib "kernel32" () As Long
Public Declare Function CloseHandle Lib "kernel32" _
    (ByVal hObject As Long) As Long
'''Types, constants and functions for OS version detection
Public Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type
Public Const VER_PLATFORM_WIN32_NT As Long = 2
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
    (lpVersionInformation As OSVERSIONINFO) As Long
'''Constant and function for detection of support of access rights by file system
Public Const FS_PERSISTENT_ACLS As Long = &H8
Public Declare Function GetVolumeInformation Lib "kernel32" _
    Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
    ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
    lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
    lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
    ByVal nFileSystemNameSize As Long) As Long

'Codemodul
Public Function CheckFileAccess(Filename As String, ByVal DesiredAccess As Long) As Long
  'CheckFileAccess function checks access rights to given file.
  'DesiredAccess - bitmask of desired access rights.
  'The function returns bitmask, which contains those bits of desired bitmask,
  'which correspond with existing access rights.

  Dim r As Long, SecDesc() As Byte, SDSize As Long, hToken As Long
  Dim PrivSet As PRIVILEGE_SET, GenMap As GENERIC_MAPPING
  Dim Volume As String, FSFlags As Long
  'Checking OS type
  If Not IsNT() Then
    'Rights not supported. Returning -1.
    CheckFileAccess = -1
    Exit Function
  End If
  'Checking access rights support by file system
  If Left$(Filename, 2) = "\\" Then
    'Path in UNC format. Extracting share name from it
    r = InStr(3, Filename, "\")
    If r = 0 Then
      Volume = Filename & "\"
    Else
      Volume = Left$(Filename, r)
    End If
  ElseIf Mid$(Filename, 2, 2) = ":\" Then
    'Path begins with drive letter
    Volume = Left$(Filename, 3)
  Else
    'If path not set, we are leaving Volume blank.
    'It retutns information about current drive.
  End If
  'Getting information about drive
  GetVolumeInformation Volume, vbNullString, 0, ByVal 0&, ByVal 0&, FSFlags, vbNullString, 0
  If (FSFlags And FS_PERSISTENT_ACLS) = 0 Then
    'Rights not supported. Returning -1.
    CheckFileAccess = -1
    Exit Function
  End If
  'Determination of buffer size
  GetFileSecurity Filename, OWNER_SECURITY_INFORMATION Or GROUP_SECURITY_INFORMATION _
      Or DACL_SECURITY_INFORMATION, 0, 0, SDSize
  If Err.LastDllError <> 122 Then
    'Rights not supported. Returning -1.
    CheckFileAccess = -1
    Exit Function
  End If
  If SDSize = 0 Then Exit Function
  ReDim SecDesc(1 To SDSize)
  'Once more call of function to obtain Security Descriptor
  If GetFileSecurity(Filename, OWNER_SECURITY_INFORMATION Or GROUP_SECURITY_INFORMATION _
      Or DACL_SECURITY_INFORMATION, SecDesc(1), SDSize, SDSize) = 0 Then
    'Error. We must return no access rights.
    CheckFileAccess = -1

    Exit Function
  End If
  'Adding Impersonation Token for thread
  ImpersonateSelf SecurityImpersonation
  'Opening of Token of current thread
  OpenThreadToken GetCurrentThread(), TOKEN_QUERY, 0, hToken
  If hToken <> 0 Then
    'Filling GenericMask type
    GenMap.GenericRead = FILE_GENERIC_READ
    GenMap.GenericWrite = FILE_GENERIC_WRITE
    GenMap.GenericExecute = FILE_GENERIC_EXECUTE
    GenMap.GenericAll = FILE_ALL_ACCESS
    'Conversion of generic rights to specific file access rights
    MapGenericMask DesiredAccess, GenMap
    'Checking access
    AccessCheck SecDesc(1), hToken, DesiredAccess, GenMap, PrivSet, Len(PrivSet), CheckFileAccess, r
    CloseHandle hToken
  End If
  'Deleting Impersonation Token
  RevertToSelf
End Function

Public Function IsNT() As Boolean
  'IsNT() function returns True, if the program works in Windows NT,
  'Windows 2000 or Windows XP operating system, and False otherwise.

  Dim OSVer As OSVERSIONINFO
  OSVer.dwOSVersionInfoSize = Len(OSVer)
  GetVersionEx OSVer
  IsNT = (OSVer.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function

'*** Aufruf ***
Sub TestCall()
  Dim bolAccessRead As Boolean
  Dim bolAccessWrite As Boolean
  bolAccessRead = CheckFileAccess("C:\Daten\EineMappe.xls", FILE_GENERIC_READ) = FILE_GENERIC_READ
  MsgBox "Lesen-Berechtigung vorhanden: " & bolAccessRead
  bolAccessWrite = CheckFileAccess("C:\Daten\EineMappe.xls", FILE_GENERIC_WRITE) = FILE_GENERIC_WRITE
  MsgBox "Schreiben-Berechtigung vorhanden: " & bolAccessWrite
End Sub

To Top


Verzeichnis-Berechtigungen des Benutzers für einen bestimmten Ordner abfragen

.Beschreibung
Abfragen, welche Berechtigungen der angemeldete Benutzer für einen bestimmten Ordner besitzt.

Wenn
- das Betriebssystem nicht vom Typ Windows NT ist (d.h. Windows NT 4.0, Windows 2000 oder Windows XP) oder
- das Dateisystem des angesprochenen Laufwerkes keine Berechtigungen unterstützt oder
- für den Ordner keine Security-Informationen vorhanden sind,
dann gibt die Funktion CheckFolderAccess generell Wahr (bzw. True) zurück, weil der Benutzer uneingeschränkten Zugriff auf den Ordner besitzt.

 

Diese Berechtigungen können für Ordner abgefragt werden:

Berechtigung Buchstabe Konstante
Lesen R FILE_GENERIC_READ
Schreiben W FILE_GENERIC_WRITE
Ausführen X FILE_GENERIC_EXECUTE
Berechtigungen ändern P WRITE_DAC
Besitz übernehmen O WRITE_OWNER
Anzeigen V FILE_LIST_DIRECTORY
Datei hinzufügen A FILE_ADD_FILE
Ordner hinzufügen S FILE_ADD_SUBDIRECTORY
Vollzugriff - FILE_ALL_ACCESS

 

.VBA-Code
Public Sub ToDo()

End Sub

To Top


Prüfen, ob ein Laufwerk Datei-/Verzeichnis-Berechtigungen unterstützt

.Beschreibung
Nur neuere Dateisysteme wie unter anderem NTFS unterstützen Zugriffsberechtigungen für Dateien und Verzeichnisse. Ältere Dateisysteme wie FAT oder DOS dagegen bieten diese Unterstützung nicht. Dieses Codebeispiel zeigt, wie Sie überprüfen können, ob ein bestimmtes Laufwerk solche Berechtigungen unterstützt.

Bevor man eine Datei öffnet, sollte man kontrollieren, ob der Benutzer genügend Berechtigungen für das Öffnen (sprich Lesen der Datei) besitzt. Noch vor dieser Kontrolle sollte man jedoch überprüfen, ob das Laufwerk, auf welchem sich die Datei befindet, überhaupt Berechtigungen unterstützt. Ist dies nämlich nicht der Fall, ist die Kontrolle der Lesen-Berechtigung hinfällig.

.VBA-Code
Public Sub CheckDriveRightsSupport()

End Sub

Verwandte Codebeispiele

Prüfen, ob das Betriebssystem Datei-/Verzeichnis-Berechtigungen unterstützt

Alle Codebeispiele von Themengebiet: Berechtigung

To Top


Prüfen, ob das Betriebssystem Datei-/Verzeichnis-Berechtigungen unterstützt

.Beschreibung
Nicht alle Betriebssysteme beziehungsweise Windows-Versionen unterstützen Zugriffsberechtigungen für Dateien und Verzeichnisse. Unterstützt werden diese nur von den Windows-Versionen vom Typ Windows NT, (d.h. Windows NT 4.0, Windows 2000 und Windows XP.

Bevor man eine Datei öffnet, sollte man kontrollieren, ob der Benutzer genügend Berechtigungen für das Öffnen (sprich Lesen der Datei) besitzt. Noch vor dieser Kontrolle sollte man jedoch überprüfen, ob das verwendete Betriebssystem überhaupt Berechtigungen unterstützt. Ist dies nämlich nicht der Fall, ist die Kontrolle der Lesen-Berechtigung hinfällig.

.VBA-Code
Public Sub CheckOSRightsSupport()

End Sub

Verwandte Codebeispiele

Prüfen, ob ein Laufwerk Datei-/Verzeichnis-Berechtigungen unterstützt

Alle Codebeispiele von Themengebiet: Berechtigung

To Top


Prüfen, ob eine Arbeitsmappe geschützt ist (Arbeitsmappenschutz)

.Beschreibung
Dieses Codebeispiel überprüft, ob eine Arbeitsmappe mit einem Arbeitsmappenschutz versehen ist. Über die Benutzeroberfläche von Microsoft Excel wird der Mappenschutz über den Menübefehl Extras/Schutz/Arbeitsmappe aktiviert.

ProtectStructure

ProtectWindows

.VBA-Code
Public Sub CheckBookProtection()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Prüfen, ob ein Arbeitsblatt geschützt ist

Prüfen, ob ein Diagrammblatt geschützt ist

To Top


Prüfen, ob ein Arbeitsblatt geschützt ist (Blattschutz)

.Beschreibung
Die hier vorgestellten VBA-Codebeispiele überprüfen, ob ein bestimmtes Arbeitsblatt mit einen Blattschutz versehen ist. Über die Benutzeroberfläche von Microsoft Excel wird der Blattschutz über den Menübefehl Extras/Schutz/Blatt aktiviert.

» Codebeispiel #1: Es existieren drei Eigenschaften des Worksheet-Objektes, die im Zusammenhang mit dem Blattschutz relevant sind: ProtectContents, ProtectDrawingObjects und ProtectScenarios. Wenn man wissen möchte, ob ein Blatt geschützt ist, muss man daher gewöhnlich alle drei Eigenschaften abfragen. Die Schwierigkeit dabei ist allerdings, dass nicht alle Blatttypen die drei Eigenschaften gleichermassen unterstützen. Die folgende Tabelle zeigt die jeweilige Verfügbarkeit pro Blatttyp (Spezialfälle sind rot markiert):

Blatttyp ProtectContents ProtectDrawingObjects ProtectScenarios
Tabellenblatt Unterstützt Unterstützt Unterstützt
Diagrammblatt Unterstützt Unterstützt Nicht unterstützt.
Laufzeitfehler 438 "Objekt unterstützt diese

Eigenschaft oder Methode nicht" tritt auf.
Excel 4.0-Makroblatt Unterstützt Unterstützt Unterstützt.
Bei aktivem Blattschutz immer True.
Internationales Makroblatt Unterstützt Unterstützt Unterstützt.
Bei aktivem Blattschutz immer True.
Dialogblatt Unterstützt.
Immer False (auch bei aktivem Blattschutz).
Unterstützt Unterstützt

Beispielsweise bei einem Diagrammblatt führt der Zugriff auf ProtectScenarios zum Laufzeitfehler 438 "Objekt unterstützt diese Eigenschaft oder Methode nicht". Und die Eigenschaft ProtectContents gibt bei einem Dialogblatt immer False zurück, egal ob der Blattschutz aktiv ist oder nicht.

» Codebeispiel #2: Dieses Codebeispiel zeigt einen völlig anderen Lösungsansatz. Weil in Microsoft Excel je nach vorhandenem Blattschutz der Menübefehl für den Blattschutz unter Extras/Schutz automatisch korrekt beschriftet wird, kann man anhand dieser Beschriftung feststellen, ob das aktive Blatt geschützt ist. Das dazu benötigte Symbolleisten-Steuerelement besitzt die ID 893. Wenn die Menüelement-Beschriftung "Blatt..." lautet, dann ist kein Schutz vorhanden. Wenn sie dagegen "Blattschutz aufheben..." lautet, ist das Blatt geschützt.

Bitte beachten Sie, dass diese Lösung nur in einer deutschsprachigen Excelversion funktioniert. Ausserdem muss der benötigte Menüelement vorhanden sein. Wenn es beispielsweise durch den Benutzer entfernt wurde, tritt der Laufzeitfehler 91 "Objektvariable oder With-Blockvariable nicht festgelegt" auf. Trotz diesen beiden Einschränkungen ist diese Lösung sehr hilfreich, wenn man beispielsweise wissen möchte, ob bei einem Diagrammblatt nur die Benutzeroberfläche gesperrt ist. In diesem Fall geben die drei Eigenschaften ProtectContents, ProtectDrawingObjects und ProtectsScenarios False zurück, obwohl ein Blattschutz vorhanden ist.

.VBA-Code #1
'Codemodul
Function CheckSheetProtection(objSheet As Object) As Boolean
  Dim bolProtection As Boolean
  On Error Resume Next
  bolProtection = objSheet.ProtectContents
  If Err.Number <> 0 Then
    bolProtection = False
    Err.Clear
  End If
  If bolProtection = True Then
    CheckSheetProtection = True
    Exit Function
  End If
  bolProtection = objSheet.ProtectDrawingObjects
  If Err.Number <> 0 Then
    bolProtection = False
    Err.Clear
  End If
  If bolProtection = True Then
    CheckSheetProtection = True
    Exit Function
  End If
  bolProtection = objSheet.ProtectScenarios
  If Err.Number <> 0 Then
    bolProtection = False
    Err.Clear
  End If
  If bolProtection = True Then
    CheckSheetProtection = True
  End If
End Function

'*** Aufruf ***
Sub TestCall()
  MsgBox "Blattschutz aktiv: " & CheckSheetProtection(ActiveSheet)
End Sub

.VBA-Code #2
Public Sub CheckProtection()
  If InStr(CommandBars.FindControl(Id:=893).Caption, "aufheben") Then
    MsgBox "Das aktive Blatt ist geschützt.", vbInformation
  Else
    MsgBox "Das aktive Blatt ist nicht geschützt.", vbInformation
  End If
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Prüfen, ob eine Arbeitsmappe geschützt ist

Prüfen, ob ein Diagrammblatt geschützt ist

To Top


Prüfen, ob ein Diagrammblatt geschützt ist (Blattschutz)

.Beschreibung
Dieses Codebeispiel findet heraus, ob ein Diagramm mit einem Blattschutz versehen ist.

.VBA-Code
Public Sub CheckSheetProtection()
  If InStr(Application.CommandBars.FindControl(Id:=893).Caption, "aufheben") Then
    MsgBox "Das aktive Blatt ist geschützt.", vbInformation
  Else
    MsgBox "Das aktive Blatt ist nicht geschützt.", vbInformation
  End If
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Prüfen, ob ein Arbeitsblatt geschützt ist

Prüfen, ob eine Arbeitsmappe geschützt ist

To Top


Prüfen, ob ein Arbeitsmappenschutz ein Kennwort verwendet

.Beschreibung
Dieses Codebeispiel ermittelt, ob der Arbeitsmappenschutz ein Kennwort verwendet.

.VBA-Code
Public Sub CheckIfBookProtectionHasPassword()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Prüfen, ob ein Arbeitsblatt geschützt ist

Prüfen, ob eine Arbeitsmappe geschützt ist

Alle Codebeispiele von Themengebiet: Kennwort

To Top


Prüfen, ob ein Blattschutz ein Kennwort verwendet

.Beschreibung
Dieses Codebeispiel ermittelt, ob ein Blattschutz ein Kennwort verwendet.

.VBA-Code
Public Sub CheckIfSheetProtectionHasPassword()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Prüfen, ob ein Arbeitsblatt geschützt ist

Prüfen, ob eine Arbeitsmappe geschützt ist

Alle Codebeispiele von Themengebiet: Kennwort

To Top


Blattschutz eines Arbeitsblattes entfernen

.Beschreibung
Dieses Codebeispiel entfernt den Blattschutz eines Arbeitsblattes. Im Beispiel wird das aktive Arbeitsblatt verwendet.

.VBA-Code #1
Public Sub RemoveSheetProtection1()
  ActiveSheet.Unprotect
End Sub

.VBA-Code #2
Public Sub RemoveSheetProtection2()
  ActiveSheet.Unprotect "Sommer"
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Prüfen, ob ein Arbeitsblatt geschützt ist

Prüfen, ob eine Arbeitsmappe geschützt ist

Arbeitsmappenschutz einer Arbeitsmappe entfernen

To Top


Arbeitsmappenschutz einer Arbeitsmappe entfernen

.Beschreibung
Mit diesem VBA-Code wird der Schutz einer Arbeitsmappe aufgehoben. Im Beispiel wird die aktive Arbeitsmappe verwendet.

.VBA-Code #1
Public Sub RemoveBookProtection1()
  ActiveWorkbook.Unprotect
End Sub

.VBA-Code #2
Public Sub RemoveBookProtection2()
  ActiveWorkbook.Unprotect "Sommer"
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Prüfen, ob ein Arbeitsblatt geschützt ist

Prüfen, ob eine Arbeitsmappe geschützt ist

Blattschutz eines Arbeitsblattes entfernen

To Top


Namen der exe-Dateien der installierten Programme zum Auswählen in ListBox füllen

.Beschreibung
Dieses Codebeispiel füllt eine ListBox (oder ComboBox) mit den Namen der exe-Dateien der auf dem Computer installierten Programme.

Legen Sie ein VBA-Projekt mit einem Codemodul und einem Benutzerformular an. Ordnen Sie auf dem Benutzerformular eine ListBox an und geben dieser den Namen lstApps. Fügen Sie den nachstehenden Programmcode in die angegebenen Module ein.

Der VBA-Code funktioniert in allen Microsoft Office-Programmen. Er kann auch in einem Visual Basic-Projekt verwendet werden, wenn die Prozedur UserForm_Initialize in Form_Load umbenannt wird.

.VBA-Code
'Deklarationsbereich des Codemoduls
Public Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _

   (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
   ByVal samDesired As Long, phkResult As Long) As Long
Public Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" _

   (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
   lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, _
   lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

'Codemodul
Public Function EnumInstalledApps() As Collection
  Dim AddressofOpenKey As Long
  Dim bolFunctionResult As Boolean
  Dim udtFileTimeStruc As FILETIME
  Dim strAppName As String
  Dim strAppNameLen As Long
  Dim intAppIndex As Integer
  Const KEY_ENUMERATE_SUB_KEYS = &H8
  Const HKEY_LOCAL_MACHINE = &H80000002
  Set EnumInstalledApps = New Collection
  intAppIndex = 0
  bolFunctionResult = Not CBool(RegOpenKeyEx(hKey:=HKEY_LOCAL_MACHINE, _

     lpSubKey:="SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths", ulOptions:=0, _
     samDesired:=KEY_ENUMERATE_SUB_KEYS, phkResult:=AddressofOpenKey))
  If bolFunctionResult = False Then GoTo ErrorHandler
  Do
    strAppNameLen = 255
    strAppName = String(strAppNameLen, CStr(0))
    bolFunctionResult = Not CBool(RegEnumKeyEx(hKey:=AddressofOpenKey, dwIndex:=intAppIndex, _

       lpName:=strAppName, lpcbName:=strAppNameLen, lpReserved:=0, lpClass:=vbNullString, _
       lpcbClass:=0, lpftLastWriteTime:=udtFileTimeStruc))
    If bolFunctionResult = False Then Exit Do

    intAppIndex = intAppIndex + 1
    strAppName = Left(strAppName, strAppNameLen)
    On Error Resume Next
    EnumInstalledApps.Add strAppName
    On Error GoTo 0
  Loop
  Call RegCloseKey(AddressofOpenKey)
  Exit Function
ErrorHandler:
  If Not AddressofOpenKey = 0 Then
    Call RegCloseKey(AddressofOpenKey)
  End If
  Set EnumInstalledApps = Nothing
End Function

'Codemodul des Benutzerformulares
Private Sub UserForm_Initialize()
  Dim aApps As Variant
  On Error Resume Next
  For Each aApps In EnumInstalledApps
    lstApps.AddItem aApps
  Next aApps
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Pfade der exe-Dateien der installierten Programme zum Auswählen in ListBox füllen

To Top


Pfade der exe-Dateien der installierten Programme zum Auswählen in ListBox füllen

.Beschreibung
Hier wird gezeigt, wie man die auf dem Computer installierten Programme herausfinden kann und zu jedem Programm den Pfad der exe-Datei in eine ListBox (oder ComboBox) eines Benutzerformulares einfüllt.

Legen Sie ein VBA-Projekt mit einem Codemodul und einem Benutzerformular an. Ordnen Sie auf dem Benutzerformular eine ListBox an und geben dieser den Namen lstApps. Fügen Sie den nachstehenden Programmcode in die angegebenen Module ein.

Der VBA-Code funktioniert in allen Microsoft Office-Programmen. Er kann auch in einem Visual Basic-Projekt verwendet werden, wenn die Prozedur UserForm_Initialize in Form_Load umbenannt wird.

.VBA-Code
'Deklarationsbereich des Codemoduls
Public Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _

   (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
   ByVal samDesired As Long, phkResult As Long) As Long
Public Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" _

   (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
   lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, _
   lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

'Codemodul
Public Function EnumInstalledApps() As Collection
  Dim AddressofOpenKey As Long
  Dim bolFunctionResult As Boolean
  Dim udtFileTimeStruc As FILETIME
  Dim strAppName As String
  Dim strAppNameLen As Long
  Dim intAppIndex As Integer
  Const KEY_ENUMERATE_SUB_KEYS = &H8
  Const HKEY_LOCAL_MACHINE = &H80000002
  Set EnumInstalledApps = New Collection
  intAppIndex = 0
  bolFunctionResult = Not CBool(RegOpenKeyEx(hKey:=HKEY_LOCAL_MACHINE, _

     lpSubKey:="SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths", ulOptions:=0, _
     samDesired:=KEY_ENUMERATE_SUB_KEYS, phkResult:=AddressofOpenKey))
  If bolFunctionResult = False Then GoTo ErrorHandler
  Do
    strAppNameLen = 255
    strAppName = String(strAppNameLen, CStr(0))
    bolFunctionResult = Not CBool(RegEnumKeyEx(hKey:=AddressofOpenKey, dwIndex:=intAppIndex, _

       lpName:=strAppName, lpcbName:=strAppNameLen, lpReserved:=0, lpClass:=vbNullString, _
       lpcbClass:=0, lpftLastWriteTime:=udtFileTimeStruc))
    If bolFunctionResult = False Then Exit Do

    intAppIndex = intAppIndex + 1
    strAppName = Left(strAppName, strAppNameLen)
    On Error Resume Next
    EnumInstalledApps.Add strAppName
    On Error GoTo 0
  Loop
  Call RegCloseKey(AddressofOpenKey)
  Exit Function
ErrorHandler:
  If Not AddressofOpenKey = 0 Then
    Call RegCloseKey(AddressofOpenKey)
  End If
  Set EnumInstalledApps = Nothing
End Function

Public Function GetAppPath(ByVal strAppName As String) As String
  Dim objWSHShell As Object
  On Error Resume Next
  Set objWSHShell = CreateObject("WScript.Shell")
  GetAppPath = objWSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\" & strAppName & "\")
  Set objWSHShell = Nothing
End Function

'Codemodul des Benutzerformulares
Private Sub UserForm_Initialize()
  Dim aApps As Variant
  On Error Resume Next
  For Each aApps In EnumInstalledApps
    lstApps.AddItem GetAppPath(aApps)
  Next aApps
End Sub

Weitere Informationen

VBA-Spezialthema: Windows Script Host (WSH)

 

Verwandte Codebeispiele

Namen der exe-Dateien der installierten Programme zum Auswählen in ListBox füllen

To Top


Dateien eines Ordners und allen Unterordnern mit Anzahl auflisten

.Beschreibung
Dieses Codebeispiel erstellt eine Liste der Dateien eines Ordners und seinen Unterordnern. Bei jeder Datei wird angegeben, wie viele Male sie vorhanden ist. Massgebend ist nur der Dateiname (Gross-/Kleinschreibung egal). Dateigrösse, Dateidatum usw. werden nicht berücksichtigt. Die Liste wird auf einem neuen Arbeitsblatt der aktiven Arbeitsmappe erstellt.

Der Programmcode wird anhand der Prozedur ListFilesWithCount gestartet. Da ein Tabellenblatt 65'536 Zeilen besitzt, können maximal 65'527 Dateien aufgelistet werden. Das Überschreiten dieser Grenze ist im Programmcode abgefangen. Die restlichen 9 Zeilen werden für Titel, Spaltenüberschriften und anderes benötigt. Die Liste wird nach Spalte "Anzahl" aufsteigend sortiert.

Wenn nur diejenigen Dateien aufgelistet werden sollen, die mehr als einmal vorhanden sind, verwenden Sie bitte das Codebeispiel Mehrfach vorhandene Dateien eines Ordners und allen Unterordnern mit Anzahl auflisten.

Es können auch mehrere, beliebige Ordner und auch Dateien mit einem bestimmten Dateinamen (Platzhalter ? und * erlaubt!) durchsucht werden. Wie das geht, zeigt das Codebeispiel Bestimmte mehrfach vorhandene Dateien von bestimmten Ordnern und allen Unterordnern mit Anzahl auflisten.

.VBA-Code
'Deklarationsbereich des Codemoduls
Private objFSO As Object
Private objFolder As Object
Private lngFolders As Long
Private lngFiles As Long
Private colFiles As New Collection

'Codemodul
Sub ListFilesWithCount()
  Const strBaseFolder As String = "C:\Daten"
  Dim lngCounter As Long
  Dim lngTotalFiles As Long
  Dim varItem As Variant
  Dim wksSheet As Worksheet
  lngFolders = 0
  lngFiles = 0
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  FindFile strBaseFolder, "*.*"
  Set objFSO = Nothing
  Application.StatusBar = "Dateiliste wird erstellt..."
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  With wksSheet
    With .Range("A1")
      .Value = "Dateien mit Anzahl"
      .Font.Bold = True
    End With
    With .Range("A8:B8")
      .Value = Array("Datei", "Anzahl")
      .Font.Bold = True
    End With
  End With
  Application.ScreenUpdating = False
  For Each varItem In colFiles
    lngCounter = lngCounter + 1
    If lngCounter = 65528 Then
      MsgBox "Es können nicht alle Dateien aufgelistet werden, weil nicht genügend Zeilen zur Verfügung stehen.", vbInformation
      Exit For
    End If
    With wksSheet
      If lngCounter Mod 50 = 0 Then
        Application.StatusBar = "Dateiliste wird erstellt... (Datei " & lngCounter & " von " & lngFiles & ")"
      End If
      .Range("A" & lngCounter + 8 & ":B" & lngCounter + 8).Value = Array(Mid$(varItem, 7), Val(Left$(varItem, 5)))
      lngTotalFiles = lngTotalFiles + Val(Left$(varItem, 5))
    End With
  Next
  With wksSheet
    .Range("A3").Value = "Basis-Ordner:"
    .Range("B3").Value = strBaseFolder
    .Range("A4").Value = "Anzahl Ordner:"
    .Range("B4").Value = lngFolders
    .Range("A5").Value = "Anzahl Dateien:"
    .Range("B5").Value = lngTotalFiles
    .Range("A6").Value = "Anzahl verschiedene Dateien:"
    .Range("B6").Value = lngCounter
    .Columns("A:B").AutoFit
    .Range("A8").Sort Key1:=.Range("B9"), Order1:=xlAscending, Header:=xlGuess
  End With
  Application.ScreenUpdating = True
  Application.StatusBar = False
  Set wksSheet = Nothing
  Set colFiles = Nothing
End Sub

Function FindFile(ByVal sFolder As String, ByVal sFile As String) As Long
  Dim objTFolder As Object
  Dim sFileName As String
  Dim iCount As Integer
  On Error GoTo ErrorHandler
  Set objFolder = objFSO.GetFolder(sFolder)
  If objFolder.Type <> "Dateiordner" Then
    'Der Ordner ist kein Dateiordner
    Exit Function
  End If
  sFileName = Dir(sFolder & "\" & sFile, vbHidden)
  lngFolders = lngFolders + 1
  While Len(sFileName) <> 0
    lngFiles = lngFiles + 1
    If lngFiles Mod 50 = 0 Then
      Application.StatusBar = "Dateien werden analysiert... (Ordner " & lngFolders & ", Datei " & lngFiles & ")"
    End If
    'Dateiname der Collection hinzufügen. Bei bereits vorhandenem Key (Dateiname) tritt der Fehler 457 auf.
    colFiles.Add "00001_" & LCase$(sFileName), LCase$(sFileName)
    sFileName = Dir()
  Wend
  If objFolder.SubFolders.Count > 0 Then
    For Each objTFolder In objFolder.SubFolders
      FindFile objTFolder.Path, sFile
    Next
  End If
  Exit Function
ErrorHandler:
  If Err.Number = 457 Then    'Key (Dateiname) ist bereits vorhanden
    'Letzte Anzahl dieser Datei abfragen
    iCount = Val(Left$(colFiles.Item(LCase$(sFileName)), 5))
    'Element aus der Collection entfernen
    colFiles.Remove LCase$(sFileName)
    'Dateiname mit Anzahl + 1 der Collection hinzufügen
    colFiles.Add Format$(iCount + 1, "00000") & "_" & LCase$(sFileName), LCase$(sFileName)
    lngFiles = lngFiles - 1
    Resume Next
  Else
    sFileName = ""
    Resume Next
  End If
End Function

Weitere Informationen

VBA-Spezialthema: FileSystemObject (FSO)

 

Verwandte Codebeispiele

Mehrfach vorhandene Dateien eines Ordners und allen Unterordnern mit Anzahl auflisten

Bestimmte mehrfach vorhandene Dateien von bestimmten Ordnern und allen Unterordnern mit Anzahl auflisten

To Top


Mehrfach vorhandene Dateien eines Ordners und allen Unterordnern mit Anzahl auflisten

.Beschreibung
Mit diesem Codebeispiel wird eine Liste erstellt, die alle Dateien zeigt, die mehrfach in einem Ordner und seinen Unterordnern vorhanden sind. Bei jeder Datei wird angegeben, wie viele Male sie vorhanden ist. Massgebend ist nur der Dateiname (Gross-/Kleinschreibung egal). Dateigrösse, Dateidatum usw. werden nicht berücksichtigt. Die Liste wird auf einem neuen Arbeitsblatt der aktiven Arbeitsmappe erstellt.

Dieses Codebeispiel ist vergleichbar mit dem Codebeispiel Dateien eines Ordners und allen Unterordnern mit Anzahl auflisten, nur dass hier ausschliesslich Dateien aufgelistet werden, die mehr als einmal vorhanden sind.

.VBA-Code
'Deklarationsbereich des Codemoduls
Private objFSO As Object
Private objFolder As Object
Private lngFolders As Long
Private lngFiles As Long
Private colFiles As New Collection

'Codemodul
Sub ListFilesWithCount()
  Const strBaseFolder As String = "C:\Daten"
  Dim lngCounter As Long
  Dim lngTotalFiles As Long
  Dim varItem As Variant
  Dim wksSheet As Worksheet
  lngFolders = 0
  lngFiles = 0
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  FindFile strBaseFolder, "*.*"
  Set objFSO = Nothing
  Application.StatusBar = "Dateiliste wird erstellt..."
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  With wksSheet
    With .Range("A1")
      .Value = "Mehrfach vorhandene Dateien mit Anzahl"
      .Font.Bold = True
    End With
    With .Range("A8:B8")
      .Value = Array("Datei", "Anzahl")
      .Font.Bold = True
    End With
  End With
  Application.ScreenUpdating = False
  For Each varItem In colFiles
    If Val(Left$(varItem, 5)) > 1 Then
      lngCounter = lngCounter + 1
      If lngCounter = 65528 Then
        MsgBox "Es können nicht alle Dateien aufgelistet werden, weil nicht genügend Zeilen zur Verfügung stehen.", vbInformation
        Exit For
      End If
      With wksSheet
        If lngCounter Mod 50 = 0 Then
          Application.StatusBar = "Dateiliste wird erstellt... (Datei " & lngCounter & " von " & lngFiles & ")"
        End If
        .Range("A" & lngCounter + 8 & ":B" & lngCounter + 8).Value = Array(Mid$(varItem, 7), Val(Left$(varItem, 5)))
        lngTotalFiles = lngTotalFiles + Val(Left$(varItem, 5))
      End With
    End If
  Next
  With wksSheet
    .Range("A3").Value = "Basis-Ordner:"
    .Range("B3").Value = strBaseFolder
    .Range("A4").Value = "Anzahl Ordner:"
    .Range("B4").Value = lngFolders
    .Range("A5").Value = "Anzahl Dateien:"
    .Range("B5").Value = lngTotalFiles
    .Range("A6").Value = "Anzahl verschiedene Dateien:"
    .Range("B6").Value = lngCounter
    .Columns("A:B").AutoFit
    .Range("A8").Sort Key1:=.Range("B9"), Order1:=xlAscending, Header:=xlGuess
  End With
  Application.ScreenUpdating = True
  Application.StatusBar = False
  Set wksSheet = Nothing
  Set colFiles = Nothing
End Sub

Function FindFile(ByVal sFolder As String, ByVal sFile As String) As Long
  Dim objTFolder As Object
  Dim sFileName As String
  Dim iCount As Integer
  On Error GoTo ErrorHandler
  Set objFolder = objFSO.GetFolder(sFolder)
  If objFolder.Type <> "Dateiordner" Then
    'Der Ordner ist kein Dateiordner
    Exit Function
  End If
  sFileName = Dir(sFolder & "\" & sFile, vbHidden)
  lngFolders = lngFolders + 1
  While Len(sFileName) <> 0
    lngFiles = lngFiles + 1
    If lngFiles Mod 50 = 0 Then
      Application.StatusBar = "Dateien werden analysiert... (Ordner " & lngFolders & ", Datei " & lngFiles & ")"
    End If
    'Dateiname der Collection hinzufügen. Bei bereits vorhandenem Key (Dateiname) tritt der Fehler 457 auf.
    colFiles.Add "00001_" & LCase$(sFileName), LCase$(sFileName)
    sFileName = Dir()
  Wend
  If objFolder.SubFolders.Count > 0 Then
    For Each objTFolder In objFolder.SubFolders
      FindFile objTFolder.Path, sFile
    Next
  End If
  Exit Function
ErrorHandler:
  If Err.Number = 457 Then    'Key (Dateiname) ist bereits vorhanden
    'Letzte Anzahl dieser Datei abfragen
    iCount = Val(Left$(colFiles.Item(LCase$(sFileName)), 5))
    'Element aus der Collection entfernen
    colFiles.Remove LCase$(sFileName)
    'Dateiname mit Anzahl + 1 der Collection hinzufügen
    colFiles.Add Format$(iCount + 1, "00000") & "_" & LCase$(sFileName), LCase$(sFileName)
    lngFiles = lngFiles - 1
    Resume Next
  Else
    sFileName = ""
    Resume Next
  End If
End Function

Weitere Informationen

VBA-Spezialthema: FileSystemObject (FSO)

 

Verwandte Codebeispiele

Bestimmte mehrfach vorhandene Dateien von bestimmten Ordnern und allen Unterordnern mit Anzahl auflisten

Dateien eines Ordners und allen Unterordnern mit Anzahl auflisten

To Top


Bestimmte mehrfach vorhandene Dateien von bestimmten Ordnern und allen Unterordnern mit Anzahl auflisten

.Beschreibung
Dieses Codebeispiel listet alle Dateien auf,
- die einen bestimmten Dateinamen (mit Mustervergleich, d.h. Platzhalter * und ? erlaubt) besitzen und
- in bestimmten Ordnern oder deren Unterordner liegen und
- mehr als einmal vorhanden sind.

Bei jeder Datei wird angegeben, wie viele Male sie vorhanden ist. Massgebend ist nur der Dateiname (Gross-/Kleinschreibung egal). Dateigrösse, Dateidatum usw. werden nicht berücksichtigt. Die Liste wird auf einem neuen Arbeitsblatt der aktiven Arbeitsmappe erstellt.

.VBA-Code
'Deklarationsbereich des Codemoduls
Private objFSO As Object
Private objFolder As Object
Private lngFolders As Long
Private lngFiles As Long
Private colFiles As New Collection

'Codemodul
Sub ListFilesWithCount()
  Const strBaseFolder1 As String = "C:\Daten"
  Const strBaseFolder2 As String = "C:\Excel\Dateien"

  Const strBaseFolder3 As String = "D:\Statistik"
  Const strPattern As String = "*.xls"
  Dim lngCounter As Long
  Dim lngTotalFiles As Long
  Dim varItem As Variant
  Dim wksSheet As Worksheet
  lngFolders = 0
  lngFiles = 0
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  FindFile strBaseFolder1, strPattern
  FindFile strBaseFolder2, strPattern

  FindFile strBaseFolder3, strPattern
  Set objFSO = Nothing
  Application.StatusBar = "Dateiliste wird erstellt..."
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  With wksSheet
    With .Range("A1")
      .Value = "Mehrfach vorhandene Dateien mit Anzahl"
      .Font.Bold = True
    End With
    With .Range("A8:B8")
      .Value = Array("Datei", "Anzahl")
      .Font.Bold = True
    End With
  End With
  Application.ScreenUpdating = False
  For Each varItem In colFiles
    If Val(Left$(varItem, 5)) > 1 Then
      lngCounter = lngCounter + 1
      If lngCounter = 65528 Then
        MsgBox "Es können nicht alle Dateien aufgelistet werden, weil nicht genügend Zeilen zur Verfügung stehen.", vbInformation
        Exit For
      End If
      With wksSheet
        If lngCounter Mod 50 = 0 Then
          Application.StatusBar = "Dateiliste wird erstellt... (Datei " & lngCounter & " von " & lngFiles & ")"
        End If
        .Range("A" & lngCounter + 8 & ":B" & lngCounter + 8).Value = Array(Mid$(varItem, 7), Val(Left$(varItem, 5)))
        lngTotalFiles = lngTotalFiles + Val(Left$(varItem, 5))
      End With
    End If
  Next
  With wksSheet
    .Range("A3").Value = "Basis-Ordner:"
    .Range("B3").Value = strBaseFolder1 & ";" & strBaseFolder2 & ";" & strBaseFolder3
    .Range("A4").Value = "Anzahl Ordner:"
    .Range("B4").Value = lngFolders
    .Range("A5").Value = "Anzahl Dateien:"
    .Range("B5").Value = lngTotalFiles
    .Range("A6").Value = "Anzahl verschiedene Dateien:"
    .Range("B6").Value = lngCounter
    .Columns("A:B").AutoFit
    .Range("A8").Sort Key1:=.Range("B9"), Order1:=xlAscending, Header:=xlGuess
  End With
  Application.ScreenUpdating = True
  Application.StatusBar = False
  Set wksSheet = Nothing
  Set colFiles = Nothing
End Sub

Function FindFile(ByVal sFolder As String, ByVal sFile As String) As Long
  Dim objTFolder As Object
  Dim sFileName As String
  Dim iCount As Integer
  On Error GoTo ErrorHandler
  Set objFolder = objFSO.GetFolder(sFolder)
  If objFolder.Type <> "Dateiordner" Then
    'Der Ordner ist kein Dateiordner
    Exit Function
  End If
  sFileName = Dir(sFolder & "\" & sFile, vbHidden)
  lngFolders = lngFolders + 1
  While Len(sFileName) <> 0
    lngFiles = lngFiles + 1
    If lngFiles Mod 50 = 0 Then
      Application.StatusBar = "Dateien werden analysiert... (Ordner " & lngFolders & ", Datei " & lngFiles & ")"
    End If
    'Dateiname der Collection hinzufügen. Bei bereits vorhandenem Key (Dateiname) tritt der Fehler 457 auf.
    colFiles.Add "00001_" & LCase$(sFileName), LCase$(sFileName)
    sFileName = Dir()
  Wend
  If objFolder.SubFolders.Count > 0 Then
    For Each objTFolder In objFolder.SubFolders
      FindFile objTFolder.Path, sFile
    Next
  End If
  Exit Function
ErrorHandler:
  If Err.Number = 457 Then    'Key (Dateiname) ist bereits vorhanden
    'Letzte Anzahl dieser Datei abfragen
    iCount = Val(Left$(colFiles.Item(LCase$(sFileName)), 5))
    'Element aus der Collection entfernen
    colFiles.Remove LCase$(sFileName)
    'Dateiname mit Anzahl + 1 der Collection hinzufügen
    colFiles.Add Format$(iCount + 1, "00000") & "_" & LCase$(sFileName), LCase$(sFileName)
    lngFiles = lngFiles - 1
    Resume Next
  Else
    sFileName = ""
    Resume Next
  End If
End Function

Weitere Informationen

VBA-Spezialthema: FileSystemObject (FSO)

 

Verwandte Codebeispiele

Dateien eines Ordners und allen Unterordner mit Anzahl auflisten

To Top


Druckvorschau/Seitenansicht anzeigen

.Beschreibung
Mit der PrintPreview-Methode wird in Microsoft Excel die Seitenansicht angezeigt.

.VBA-Code
Public Sub ShowPrintPreview()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Alle Codebeispiele von Themengebiet: Drucker/Drucken

To Top


Auffangbare Laufzeitfehler von VBA/VB auflisten

.Beschreibung
Dieses Codebeispiel listet alle auffangbaren Fehler/Laufzeitfehler der Programmiersprache VBA/VB auf einem neuen Arbeitsblatt der aktiven Arbeitsmappe auf.

.VBA-Code
Public Sub ListTrappableErrors()
  Dim wksSheet As Worksheet
  Dim lngError As Long
  Dim lngCounter As Long
  Set wksSheet = ActiveWorkbook.Worksheets.Add
  With wksSheet
    .Range("A3:B3").Value = Array("Code", "Fehler")
    .Range("A3:B3").Font.Bold = True
  End With
  lngCounter = 3
  For lngError = 1 To 1000
    If Error(lngError) <> "Anwendungs- oder objektdefinierter Fehler" Then
      lngCounter = lngCounter + 1
      With wksSheet
        .Cells(lngCounter, 1).Value = lngError
        .Cells(lngCounter, 2).Value = Error(lngError)
      End With
    End If
  Next lngError
  With wksSheet
    .Columns("A:B").AutoFit
    .Range("A1").Value = "Auffangbare Fehler"
    .Range("A1").Font.Bold = True
  End With
  Set wksSheet = Nothing
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

To Top


MIDI-Datei abspielen

.Beschreibung
Eine MIDI-Datei kann am einfachsten abgespielt werden, indem man das ActiveX-Control "MediaPlayer" zu Hilfe nimmt.

.VBA-Code
Public Sub PlayMIDIFile()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Audio-Datei abspielen

Video-Datei abspielen

Klang ausgeben

Warnton ausgeben

Musik-CD abspielen

Alle Codebeispiele von Themengebiet: Multimedia

To Top


Drücken einer Taste auf der Tastatur simulieren

.Beschreibung
...

Es wird nicht einfach ein Tastenbefehl an das aktive Fenster gesendet, so wie es bei der SendKeys-Anweisung von VBA der Fall ist. Der hier vorgestellte Programmcode simuliert das Drücken einer Taste, indem ein Tastaturereignis ausgelöst wird.

.VBA-Code
'Deklarationsbereich
Const VER_PLATFORM_WIN32_NT = 2
Const VER_PLATFORM_WIN32_WINDOWS = 1
Const VK_ASTERICS = &H6A
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2

Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type

Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _

   (lpVersionInformation As OSVERSIONINFO) As Long
Declare Sub Keybd_Event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _

   ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Declare Function SetKeyboardState Lib "user32" (lppbKeyState As Byte) As Long

'Codemodul
Sub PressKey()
  Dim bytKeys(255) As Byte
  Dim typOS As OSVERSIONINFO
  Dim lngRC As Long
  typOS.dwOSVersionInfoSize = Len(typOS)
  lngRC = GetVersionEx(typOS)
  If typOS.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then

    'Win95/98
    bytKeys(VK_ASTERICS) = 1
    SetKeyboardState bytKeys(0)
  Else

    'WinNT/2000
    keybd_event VK_ASTERICS, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
    keybd_event VK_ASTERICS, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
  End If
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

NumLock/CapsLock/ScrollLock aktivieren/deaktivieren

Alle Codebeispiele von Themengebiet: Taste

To Top


NumLock/CapsLock/ScrollLock aktivieren/deaktivieren

.Beschreibung
...

TODO: Code

.VBA-Code
'Deklarationsbereich
Const VER_PLATFORM_WIN32_NT = 2
Const VER_PLATFORM_WIN32_WINDOWS = 1
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2

Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type

Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _

   (lpVersionInformation As OSVERSIONINFO) As Long
Declare Sub Keybd_Event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _

   ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Declare Function SetKeyboardState Lib "user32" (lppbKeyState As Byte) As Long

'Codemodul
Sub PressKey()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Drücken einer Taste auf der Tastatur simulieren

Alle Codebeispiele von Themengebiet: Taste

To Top


Zellbereich als HTML-Datei speichern

.Beschreibung
Dieses Codebeispiel speichert einen Zellbereich als eine neue HTML-Datei (Dateinamenerweiterung "htm").

.VBA-Code
Public Sub SaveRangeAsHTMLFile()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Arbeitsblatt mit dem Internet Assistent als HTML-Datei speichern

Zellbereich oder Diagrammobjekt mit dem Internet Assistent als HTML-Datei speichern

To Top


Verknüpfte Bereiche von Formular-Steuerelementen auflisten

.Beschreibung
Einige der in Microsoft Excel zur Verfügung stehenden Formular-Steuerelemente können eine so genannte Ausgabeverknüpfung und zum Teil einen Listenbereich besitzen. Diese Tabelle zeigt die Steuerelemente mit den erwähnten Eigenschaften:

Steuerelement (de) Steuerelement (en) Ausgabeverknüpfung Listenbereich
Bildlaufleiste ScrollBar Ja Nein
Drehfeld SpinButton Ja Nein
Kombinationsfeld DropDown Ja Ja
Kontrollkästchen CheckBox Ja Nein
Listenfeld ListBox Ja Ja
Optionsfeld OptionButton Ja Nein

» Codebeispiel #1: Dieses Codebeispiel erstellt eine Liste der Ausgabeverknüpfungen und Listenbereiche der Formular-Steuerelemente des aktiven Arbeitsblattes. Die Liste wird im Direktfenster des VBA-Editors ausgegeben.

» Codebeispiel #2: Bei diesem Codebeispiel wird ebenfalls die Liste erstellt, wobei hier jedoch sämtliche Arbeitsblätter der aktiven Arbeitsmappe berücksichtigt werden. Die Liste wird im Direktfenster des VBA-Editors ausgegeben.

.VBA-Code #1
Public Sub ListFormControlsLinksOfSheet()
  Dim objFormControl As Object
  Dim objShape As Shape
  Dim strResult As String
  On Error Resume Next
  For Each objShape In ActiveSheet.Shapes
    If objShape.Type = msoFormControl Then
      Set objFormControl = objShape.DrawingObject
      strResult = objFormControl.ListFillRange
      If Err.Number = 0 Then
        If strResult <> "" Then
          Debug.Print objShape.Name & ": Listenbereich: " & strResult
        Else
          Debug.Print objShape.Name & ": Listenbereich: (Nicht festgelegt)"
        End If
      Else
        Err.Clear
      End If
      strResult = objFormControl.LinkedCell
      If Err.Number = 0 Then
        If strResult <> "" Then
          Debug.Print objShape.Name & ": Ausgabeverknüpfung: " & strResult
        Else
          Debug.Print objShape.Name & ": Ausgabeverknüpfung: (Nicht festgelegt)"
        End If
      Else
        Err.Clear
      End If
      Set objFormControl = Nothing
    End If
  Next
End Sub

.VBA-Code #2
Public Sub ListFormControlsLinksOfBook()
  Dim objFormControl As Object
  Dim objShape As Shape
  Dim wksSheet As Worksheet
  Dim strResult As String
  On Error Resume Next
  For Each wksSheet In ActiveWorkbook.Worksheets
    For Each objShape In wksSheet.Shapes
      If objShape.Type = msoFormControl Then
        Set objFormControl = objShape.DrawingObject
        strResult = objFormControl.ListFillRange
        If Err.Number = 0 Then
          If strResult <> "" Then
            Debug.Print wksSheet.Name & " > " & objShape.Name & ": Listenbereich: " & strResult
          Else
            Debug.Print wksSheet.Name & " > " & objShape.Name & ": Listenbereich: (Nicht festgelegt)"
          End If
        Else
          Err.Clear
        End If
        strResult = objFormControl.LinkedCell
        If Err.Number = 0 Then
          If strResult <> "" Then
            Debug.Print wksSheet.Name & " > " & objShape.Name & ": Ausgabeverknüpfung: " & strResult
          Else
            Debug.Print wksSheet.Name & " > " & objShape.Name & ": Ausgabeverknüpfung: (Nicht festgelegt)"
          End If
        Else
          Err.Clear
        End If
        Set objFormControl = Nothing
      End If
    Next
  Next
End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Verknüpfte Bereiche (RowSource) von ListBox- und ComboBox-Steuerelementen eines VBA-Projektes auflisten

Zellbereiche der Konsolidierungen in einer Arbeitsmappe auflisten

Zellbereiche und Eigenschaften einer Konsolidierung auflisten

To Top


Verknüpfte Bereiche (RowSource) von ListBox- und ComboBox-Steuerelementen eines VBA-Projektes auflisten

.Beschreibung
Die nachstehende Prozedur analysiert alle Benutzerformulare des VBA-Projektes der aktiven Arbeitsmappe und gibt zu jedem ListBox- und ComboBox-Steuerelement den Inhalt der RowSource-Eigenschaft im Direktfenster des VBA-Editors aus.

Damit der Programmcode ausgeführt werden kann, muss im VBA-Projekt ein Verweis auf die Objektbibliothek "Microsoft Visual Basic for Applications Extensibility" gesetzt werden (Menü Extras/Verweise).

.VBA-Code
Public Sub ListRowSources()
  Dim objComponent As VBComponent
  Dim objControl As Control
  Dim strRowSource As String
  On Error Resume Next
  For Each objComponent In ActiveWorkbook.VBProject.VBComponents
    If objComponent.Type = vbext_ct_MSForm Then
      For Each objControl In objComponent.Designer.Controls
        strRowSource = objControl.RowSource
        If Err.Number = 0 Then
          Debug.Print objComponent.Name & " (" & objComponent.Properties("Caption") & _

             ") > RowSource von " & objControl.Name & ": " & strRowSource
        Else
          Err.Clear
        End If
      Next objControl
    End If
  Next objComponent
End Sub

.Hinweis
Sie fragen sich vielleicht, welchen Zweck der obige Programmcode besitzt. Nun, der Zweck ist folgender:

Auf einem Benutzerformular können sowohl in Microsoft Excel für Windows als in Microsoft Excel für Macintosh ListBox- und ComboBox-Steuerelemente verwendet werden. Die RowSource-Eigenschaft jedoch steht auf Macintosh-Systemen nicht zur Verfügung. Wenn diese Eigenschaft trotzdem verwendet wird, erscheint der Laufzeitfehler 380 mit dem Meldungstext "Eigenschaft RowSource konnte nicht gesetzt werden. Ungültiger Eigenschaftswert." (englisch "Could not set the RowSource property. Invalid property value.").

Wenn Sie also möchten, dass das VBA-Programm auch mit Microsoft Excel für Macintosh funktioniert, dürfen Sie RowSource nicht verwenden. Wenn Sie RowSource jedoch bereits 'ausgiebig' benutzt haben, können Sie anhand des obigen Codebeispiels alle noch benutzten RowSource-Eigenschaften in Ihrem VBA-Projekt aufspüren.

Weitere Informationen

Phil's Office Secrets: Kompatibilität zwischen Excel für Windows und Excel für Macintosh

 

Verwandte Codebeispiele

Verknüpfte Bereiche von Formular-Steuerelementen auflisten

Zellbereiche der Konsolidierungen in einer Arbeitsmappe auflisten

Zellbereiche und Eigenschaften einer Konsolidierung auflisten

To Top


Zellbereiche der Konsolidierungen in einer Arbeitsmappe auflisten

.Beschreibung
Über den Menübefehl Daten/Konsolidieren können Sie in Microsoft Excel mehrere Zellbereiche zu einer so genannten Konsolidierungstabelle zusammenfassen. Dies ist die Tabelle mit den zusammengefassten Ergebnissen, die im Zielbereich angezeigt wird. Microsoft Excel erstellt die Konsolidierungstabelle durch Anwenden der ausgewählten zusammenfassenden Funktion auf die angegeben Werte im Quellbereich.

Das folgende Codebeispiel erstellt eine ausführliche Liste aller in der aktiven Arbeitsmappe benutzten Konsolidierungen. Dazu werden alle Arbeitsblätter nach Konsolidierungen durchsucht und zu jeder gefundenen Konsolidierung eine Liste mit den verwendeten Zellbereichen (Quellen/Bezüge) ausgegeben. Zudem wird angegeben, ob die Quelldaten verknüpft sind oder nicht.

.VBA-Code
Public Sub ListSourcesOfAllConsolidations()
  Dim wksReportSheet As Worksheet
  Dim wksSheet As Worksheet
  Dim avarSources As Variant
  Dim intCounter As Integer
  Dim lngRow As Long
  lngRow = 2
  Set wksReportSheet = Worksheets.Add
  With wksReportSheet
    .Range("A1").Value = "Konsolidierungen"
    .Range("A1").Font.Bold = True
    .Range("A1").Font.Size = .Range("A1").Font.Size + 2
    For Each wksSheet In ActiveWorkbook.Worksheets
      If wksSheet.Name <> wksReportSheet.Name Then
        lngRow = lngRow + 1
        .Cells(lngRow, 1).Value = wksSheet.Name
        .Cells(lngRow, 1).Font.Bold = True
        avarSources = wksSheet.ConsolidationSources
        If IsEmpty(avarSources) Then
          lngRow = lngRow + 1
          .Cells(lngRow, 1).Value = "(Keine Konsolidierung)"
        Else
          If wksSheet.ConsolidationOptions(3) = True Then
            lngRow = lngRow + 1
            .Cells(lngRow, 1).Value = "(Konsolidierung mit verknüpften Quelldaten)"
          Else
            lngRow = lngRow + 1
            .Cells(lngRow, 1).Value = "(Konsolidierung ohne verknüpfte Quelldaten)"
          End If
          For intCounter = 1 To UBound(avarSources)
            lngRow = lngRow + 1
            .Cells(lngRow, 1).Value = "Bezug " & CStr(intCounter) & ": " & avarSources(intCounter)
          Next intCounter
        End If
        lngRow = lngRow + 1
      End If
    Next
    .Columns("A").AutoFit
  End With
  Set wksReportSheet = Nothing
End Sub

Weitere Informationen

Phil's Office Secrets: Kompatibilität zwischen Excel für Windows und Excel für Macintosh

 

Verwandte Codebeispiele

Zellbereiche und Eigenschaften einer Konsolidierung auflisten

Verknüpfte Bereiche von Formular-Steuerelementen auflisten

Verknüpfte Bereiche (RowSource) von ListBox- und ComboBox-Steuerelementen eines VBA-Projektes auflisten

To Top


Zellbereiche und Eigenschaften einer Konsolidierung auflisten

.Beschreibung
Über den Menübefehl Daten/Konsolidieren können Sie in Microsoft Excel mehrere Zellbereiche zu einer so genannten Konsolidierungstabelle zusammenfassen. Dies ist die Tabelle mit den zusammengefassten Ergebnissen, die im Zielbereich angezeigt wird. Microsoft Excel erstellt die Konsolidierungstabelle durch Anwenden der ausgewählten zusammenfassenden Funktion auf die angegeben Werte im Quellbereich.

Dieses Codebeispiel listet die Zellbereiche (Quellen/Bezüge) einer Konsolidierung auf. Zusätzlich wird angezeigt, ob die Quelldaten verknüpft sind oder nicht.

.VBA-Code
Public Sub ListConsolidationSettings()
  Dim wksSheet As Worksheet
  Dim avarSources As Variant
  Dim avarOptions As Variant
  Dim lngFunction As Long
  Dim strFunctionName As String
  Dim intCounter As Integer
  avarSources = ActiveSheet.ConsolidationSources
  If IsEmpty(avarSources) Then
    MsgBox "Auf dem aktiven Blatt ist keine Konsolidierung vorhanden.", vbInformation
  Else
    lngFunction = ActiveSheet.ConsolidationFunction
    Select Case lngFunction
      Case xlAverage
        strFunctionName = "Mittelwert"
      Case xlCount
        strFunctionName = "Anzahl"
      Case xlCountNums
        strFunctionName = "Anzahl Zahlen"
      Case xlMax
        strFunctionName = "Maximum"
      Case xlMin
        strFunctionName = "Minimum"
      Case xlProduct
        strFunctionName = "Produkt"
      Case xlStDev
        strFunctionName = "Standardabweichung (Stichprobe)"
      Case xlStDevP
        strFunctionName = "Standardabweichung (Grundgesamtheit)"
      Case xlSum
        strFunctionName = "Summe"
      Case xlVar
        strFunctionName = "Varianz (Stichprobe)"
      Case xlVarP
        strFunctionName = "Varianz (Grundgesamtheit)"
    End Select
    avarOptions = ActiveSheet.ConsolidationOptions
    Set wksSheet = Worksheets.Add
    With wksSheet
      .Range("A1").Value = "Konsolidierung von " & ActiveSheet.Name
      .Range("A1").Font.Bold = True
      .Range("A3").Value = "Konsolidierungsfunktion:"
      .Range("A4").Value = "Beschriftung aus oberster Zeile:"
      .Range("A5").Value = "Beschriftung aus linker Spalte:"
      .Range("A6").Value = "Verknüpfungen mit Quelldaten:"
      .Range("B3").Value = strFunctionName
      .Range("B4").Value = IIf(avarOptions(1) = True, "Ja", "Nein")
      .Range("B5").Value = IIf(avarOptions(2) = True, "Ja", "Nein")
      .Range("B6").Value = IIf(avarOptions(3) = True, "Ja", "Nein")
      .Range("A8").Value = "Zellbereiche/Bezüge"
      .Range("A8").Font.Bold = True
      For intCounter = 1 To UBound(avarSources)
        .Cells(intCounter + 8, 1).Value = avarSources(intCounter)
      Next intCounter
      .Columns("A:B").AutoFit
    End With
    Set wksSheet = Nothing
  End If
End Sub

Weitere Informationen

Phil's Office Secrets: Kompatibilität zwischen Excel für Windows und Excel für Macintosh

 

Verwandte Codebeispiele

Zellbereiche der Konsolidierungen in einer Arbeitsmappe auflisten

Verknüpfte Bereiche von Formular-Steuerelementen auflisten

Verknüpfte Bereiche (RowSource) von ListBox- und ComboBox-Steuerelementen eines VBA-Projektes auflisten

To Top


Datenmaske öffnen

.Beschreibung
Hier wird gezeigt, wie man mit VBA die Datenmaske von Microsoft Excel öffnen kann. Über die Benutzeroberfläche wird dazu der Menübefehl "Maske" des Menüs "Daten" benutzt.

ActiveSheet.ShowDataForm

Application.CommandBars.FindControl(Id:=860).Execute

.VBA-Code
Public Sub ShowDataForm()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Datenmaske mit einem bestimmten Datensatz öffnen

To Top


Datenmaske mit einem bestimmten Datensatz öffnen

.Beschreibung
Wenn man die Datenmaske öffnet, wird standardmässig der erste Datensatz der Datenliste angezeigt. Anhand eines kleinen Tricks kann man erreichen, dass ein bestimmter Datensatz angezeigt wird.

.VBA-Code
Public Sub ShowDataFormWithRecord()

End Sub

Weitere Informationen

Excel-Objektmodell: Eigenschaften des Application-Objektes

 

Verwandte Codebeispiele

Datenmaske öffnen

To Top

Haben Sie Fragen, Anregungen oder Hinweise?
Mail senden an: philipp_von_wartburg@yahoo.de

Zuletzt aktualisiert am 4.03.2006 / 18:00 Uhr
© 2002-2006 by Philipp von Wartburg, CH-8916 Jonen

Alle Rechte vorbehalten