WORD
Am Ende des aktiven Dokuments weiterschreiben
Application.ActiveDocument.Range.InsertAfter „HALLO“
EXCEL
Was macht SET?
BlattMaster
Sub BlattMaster(Aktion As Integer) 'Mögliche Aktionen: '1 = Alle bis auf ActiveSheet ausblenden '2 = Alle einblenden '3 = Alle bis auf ActiveSheet löschen Dim AktivesBlatt As Object Dim Blatt As Object, i As Integer If Aktion > 3 Or Aktion < 1 Then MsgBox "UNGÜLTIGES ARGUMENT", vbCritical, "BlattMaster" End If Set AktivesBlatt = ActiveSheet For Each Blatt In ActiveWorkbook.Sheets If Blatt Is AktivesBlatt Then 'nix machen Else Select Case Aktion Case 1 '1 -> Ausblenden Blatt.Visible = False Case 2 '2 -> Einblenden Blatt.Visible = True Case 3 '3 -> Löschen i = i + 1 AktivesBlatt.Cells(i, 1) = Blatt.Name Application.DisplayAlerts = False Blatt.Delete Application.DisplayAlerts = True End Select End If Next AktivesBlatt.Select End Sub
Schonda
Function schonda(BlattName As String) As Boolean Dim SH As Worksheet For Each SH In Worksheets If SH.Name = BlattName Then schonda = True Exit For End If Next End Function
Alle Blätter verstecken
Sub AlleAnzeigen() Dim i As Integer 'Wenn der admin angemeldet ist, alle Blätter anzeigen If Application.UserName = "admin" Then For i = 1 To ActiveWorkbook.Sheets.Count Sheets(i).Visible = True Next Else 'sonst: alle Blätter bis auf "Inhalt" verstecken For i = 1 To ActiveWorkbook.Sheets.Count If Sheets(i).Name <> "Inhalt" Then Sheets(i).Visible = xlSheetVeryHidden End If Next End If End Sub
Alle Blätter wieder anzeigen
Sub AlleMappenAlleBlätterSichtbar() Dim i, j For i = 1 To Workbooks.Count Debug.Print Workbooks(i).Name & " (" & Workbooks(i).Sheets.Count & ")" For j = 1 To Workbooks(i).Sheets.Count Debug.Print " " & _ Workbooks(i).Sheets(j).Name & _ "(" & Workbooks(i).Sheets(j).Visible & ")" Workbooks(i).Sheets(j).Visible = True Next Next End Sub
Pfad der aktuellen Mappe
x = ActiveWorkbook.Path 'c:\temp\wichtig
'Ordner darüber y = left(ActiveWorkbook.Path,instrrev(ActiveWorkbook.Path,"\")) 'c:\temp\
Kalenderwochen 2016
Im Jahr 2016 ist die KW in Deutschland <> der KW in USA. Ggf. ISOKALENDERWOCHE() verwenden
Datum abschneiden und prüfen
Sub SpeichernBitte() Dim N As String If IsNumeric(Left(ActiveWorkbook.Name, 14)) = True Then N = Mid(ActiveWorkbook.Name, 16) ActiveWorkbook.SaveAs _ ActiveWorkbook.Path & "\" & Format(Now, "YYYYMMDDHHMMSS") & "_" & N Else ActiveWorkbook.SaveAs _ ActiveWorkbook.Path & "\" & Format(Now, "YYYYMMDDHHMMSS") _ & "_" & ActiveWorkbook.Name End If End Sub
Aktuelle Mappe im gleichen Verzeichnis speichern
und Datum anhängen.
Sub speichern_datum_rechts()
Dim N As String ‚Dateiname
Dim P As String ‚Pfad
P = ActiveWorkbook.Path & „\“
‚Suche von rechts ab den Punkt im Dateinamen und schneidet von da an ab
N = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, „.“) – 1)
N = N & „_“ & Format(Date, „YYYYMMDD“)
ActiveWorkbook.SaveAs P & N
MsgBox „App:“ & Application.Name & vbNewLine & „Ort:“ & P & vbNewLine & „Name:“ & N
End Sub
Zinsen berechnen und ausgeben
Sub VielGeld()
Dim Ende As Double
Dim ZinsSatz As Double
Dim ZinsenEuro As Double
Dim Kontostand As Double ‚aktueller Kontostand
Dim Jahre As Integer
‚Startkapital auf Konto einzahlen
Kontostand = Cells(2, 2) ‚range(„B2“) range(„xStart“)
Ende = Range(„B3“)
ZinsSatz = Range(„B4“)
Do
Jahre = Jahre + 1
ZinsenEuro = Kontostand * ZinsSatz
Kontostand = Kontostand + ZinsenEuro
Debug.Print Jahre, Kontostand, ZinsenEuro
‚Cells(Jahre + 6, 1) = Jahre
Cells(Jahre + 6, 1) = Year(Date) + Jahre ‚echte Jahre Zählen
Cells(Jahre + 6, 2) = ZinsenEuro
Cells(Jahre + 6, 3) = Kontostand
Loop Until Kontostand >= Ende
End Sub
MwSt mit ByRef
Sub Test()
Dim Netto, DK, D, F
Netto = 100
MwSt Netto, DK, D, F
Debug.Print Netto, DK, D, F
End Sub
Sub MwSt(Netto, DK, D, F)
DK = Netto * 1.25
D = Netto * 1.19
F = Netto * 1.2
End Sub
Alle Mappen und Blätter anzeigen
Sub AlleMappenUndBlätter()
Dim i As Integer, j As Integer
For i = 1 To Workbooks.Count
Debug.Print Workbooks(i).Name
For j = 1 To Workbooks(i).Sheets.Count
Debug.Print “ “ & Workbooks(i).Sheets(j).Name
Next
Next
End Sub
Sub AllesAnzeigen()
Dim T As String, A As Integer, i As Integer, k As String
‚Mappe, Anzahl Blätter, Blatt-Namen, Gesamt
T = „Mappe: “ & ActiveWorkbook.FullName & vbNewLine
A = ActiveWorkbook.Sheets.Count
T = T & „Anzahl: “ & A & vbNewLine
For i = 1 To A
T = T & k & ActiveWorkbook.Sheets(i).Name
k = „, “
Next
‚T = T & vbNewLine & „Gesamt: “ & Sheets(„Zusammenfassung“).Range(„F16“).Value
T = T & vbNewLine & „Gesamt: “ & _
Sheets(„Zusammenfassung“).PivotTables(„HUGO123“).GetData(„Wert“)
MsgBox T
End Sub
Letztes Blatt in der Mappe finden
? sheets.Count
10
? sheets(10).name
Mit Event
? sheets(sheets.Count).name
Mit Event
Blätter mit Monatsnamen einfügen
Sub AlleMonateAlsBlattEinfügen()
Dim i As Integer, sh As Worksheet
For i = 1 To 12
Set sh = Worksheets.Add(, Sheets(Sheets.Count))
sh.Name = MonthName(i) & “ “ & Year(Date)
Next
End Sub
Sub AlleMonateWeg()
Dim i As Integer
‚Meldungen abschalten
Application.DisplayAlerts = False
For i = 1 To 12
‚Blatt löschen
Sheets(MonthName(i) & “ “ & Year(Date)).Delete
Next
‚Meldungen wieder anschalten
Application.DisplayAlerts = True
End Sub
Eine bestimmte PT aktualisieren
sheets(„Zusammenfassung“).pivottables(„HUGO123“).PivotCache.Refresh
Alle PT anzeigen und aktualisieren
Sub AllePT()
Dim p As PivotTable, B As Worksheet
For Each B In Worksheets
For Each p In B.PivotTables
Debug.Print B.Name, p.Name
p.PivotCache.Refresh
Next
Next
End Sub