Blog

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

kw2016

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

EXVBA1_Zinsen

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