Tipps

Excel Blätter

Neues Blatt anlegen und benennen

Dim Sh as Worksheet
 Set Sh = Worksheets.add
 Sh.name = "Neues Blatt"

Alle gewählen Blätter durchlaufen

Durch alle markierten Blätter der Mappe durchlaufen.
Der Name des Blatts wird im Direktbereich mit debug.print ausgegeben.
In jedes Blatt wird in der Zelle „A1“ der Text „Hallo“ geschrieben.

Sub AlleBlätter()
 Dim B As Worksheet 'Objektvariable anlegen
 For Each B In ActiveWindow.SelectedSheets 'Auflistung der markierten Blätter
 Debug.Print "Ausgewählt:" & B.Name 'Name des Blatts ausgeben
 B.Cells(1, 1) = "Hallo" 'in jede Zelle A1 "Hallo" schreiben
 Next
End Sub

Alle Blätter in der aktiven Mappe durchlaufen

Sub AlleBlätter()
  Dim E As Object
  'Alle Blätter Diagramme und Arbeitsblätter
  For Each E In Sheets
    Debug.Print E.Name, TypeName(E)
  Next
End Sub

Sub AlleWorksheets()
  Dim E As Worksheet
  'Nur Arbeitsblätter
  For Each E In Worksheets
    Debug.Print E.Name, TypeName(E)
  Next
End Sub

Sub AlleDiagramme()
  Dim E As Chart
  'Nur Diagramme
  For Each E In Charts
    Debug.Print E.Name, TypeName(E)
  Next
End Sub

Blätter verschieben

Sub AnErsteStelle()
  Dim Sh As Worksheet
  Set Sh = ActiveSheet
  Sh.Move Sheets(1)
End Sub

Sub AnLetzterStelle()
  Dim Sh As Worksheet
  Set Sh = ActiveSheet
  Sh.Move , Sheets(Sheets.Count)
End Sub

Neues Blatt erstellen und Verweis auf Blatt

Function MacheBlatt(n As String) As Worksheet

'Neues Blatt wird erstellt, wenn es noch nicht vorhanden ist
'Rückgabewert: Verweis auf Blatt

 Dim S As Worksheet, gefunden As Boolean
 For Each S In Worksheets
   If S.Name = n Then
     gefunden = True
     Exit For
   End If
 Next

 If gefunden = False Then 'Blatt nicht vorhanden
    Set S = Worksheets.Add(Sheets(1))
    S.Name = n
 End If

 Set MacheBlatt = S
End Function

In welchem benannten Bereich ist die Zelle

Function BereichsName(oCellA As Range) As Variant

'In welchem benannten Bereich ist eine Zelle
   Dim oCell As Range
   Dim oName As Name
   'Set oCell = Range(oCellA.Formula)
   Set oCell = oCellA
   For Each oName In ThisWorkbook.Names
      If oName.RefersToRange.Parent Is oCell.Parent Then
         If Not Intersect(oCell, oName.RefersToRange) Is Nothing Then
            BereichsName = oName.Name
            Exit Function
         End If
      End If
   Next

End Function

Excel Functions

Zahlen und Leerzeichen aus einer Zelle Filtern

z.B. aus NurZahlen(„ABC123 XYZ456X“) wird 123 456

Function NurZahlen(Text As String)
 Dim Z As String
 Dim i As Integer
 Dim Erg As String
 For i = 1 To Len(Text)
 Z = Mid(Text, i, 1)
 If Z = " " Then
 Erg = Erg & Z
 ElseIf IsNumeric(Z) Then
 Erg = Erg & Z
 End If
 Next
 NurZahlen = Erg
 End Function
 Werte subtrahieren statt addieren

Function SumDif(B As Range)

'Subtrahiert alle Werte des Bereichs vom ersten Wert
 'z.B. bei 10;20;30
 'Ergebnis = 10-20-30 = -40
 Dim E As Range, i As Integer
 Dim Res As Double

For Each E In B
 If i = 0 Then 'erstes Element
 Res = E.Value
 Else
 Res = Res - E.Value
 End If
 i = i + 1
 Next
 SumDif = Res
 End Function

Längsten Eintrag in einer Spalte finden (mit Matrix-Funktion)

Eine Excel-Liste soll nach Access importiert werden.
Um die Felder der Tabelle anzupassen wird die Anzahl der Zeichen des längsten Eintrags einer Spalte benötigt.
Das kann mit einer Kombination der Funktionen MAX und LÄNGE als Matrix-Funktion erreicht werden, z.B.

{=MAX(LÄNGE(D3:D6147))}

Liefert das Maximum der Längenberechnung in den Zellen D3:D6147.
Die Formel muß als Matrix-Funktione gespeichert werden, statt der Enter-Taste bitte Shift+STRG+Enter drücken.

LÄNGE(D3:D6147) berechnet für jede Zelle die Anzahl der Zeichen und speichert das Ergebnis in einer Matrix im Speicher.
MAX() findet in dieser Matrix den größten Wert und liefert das Ergebnis der Formel.

Excel Log-Datei schreiben

Erzeugt die Datei sys.log im gleichen Verzeichnis und protokolliert alle Änderungen an der Mappe

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 Open ActiveWorkbook.Path & "\sys.log" For Append As 1
 Write #1, Now() & "," & Application.UserName & "," _
 & Sh.Name & "," & Target.Address & "," & Target.Value
 Close #1
 End Sub

Blattschutz aufheben Excel 2010

Der Excel-Blattschutz schützt vor versehentlichem Überschreiben einer Zelle.
Mit der folgenden Prozedur kann das Blatt entsperrt werden:

Sub unprotectX()
 Dim i As Integer, j As Integer, k As Integer
 Dim l As Integer, m As Integer, n As Integer
 Dim i1 As Integer, i2 As Integer, i3 As Integer
 Dim i4 As Integer, i5 As Integer, i6 As Integer
 On Error Resume Next
 For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
 For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
 For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
 For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126

kennwort = Chr(i)& Chr(j) & Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
 ActiveSheet.Unprotect kennwort
 If ActiveSheet.ProtectContents = False Then
 MsgBox "Fertig" & vbCr & "Das alternative Kennwort lautet:" & vbCr & kennwort
 Debug.Print kennwort
 Exit Sub
 End If
 Next: Next: Next: Next: Next: Next
 Next: Next: Next: Next: Next: Next
 End Sub

Excel Pivot Gesamtes Feld erweitern/reduzieren

Eigene Buttons für „Gesamtes Feld erweitern“ und „gesamtes Feld reduzieren“ bei einer Pivot-Table

Sub Pivot_Minus()
 On Error Resume Next
 ActiveSheet.PivotTables(ActiveCell.PivotTable.Name) _
 .PivotFields(ActiveCell.PivotCell.PivotField.Name).ShowDetail = False
End Sub

Sub Pivot_Plus()
 On Error Resume Next
 ActiveSheet.PivotTables(ActiveCell.PivotTable.Name) _
 .PivotFields(ActiveCell.PivotCell.PivotField.Name).ShowDetail = True
End Sub

Andere Office-Anwendungen

Powerpoint Pfad auf allen Folien

Schreibt den Pfad und Namen der Präsentation als Textfeld auf alle Folien

Sub AlleSlides()
  Dim S As Slide
  For Each S In ActivePresentation.Slides
    S.Select
    S.Shapes.AddLabel(msoTextOrientationHorizontal, 248, 515, 6.875, 13.75).Select
    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Text = _
    ActivePresentation.FullName
  Next
End Sub