VBA CheatSheet?

UFORM
------------------------------------------------------------------------------------------------------------------------------------------
Option Explicit

Public filename As String

Private Sub Auswahl_Click()

  'Hinweis: Application.GetOpenFilename()
  ' könnte vielleicht hier helfen

  filename = Application.GetOpenFilename()

  TextBox1.Text = filename

End Sub


Private Sub Dateiname_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    MsgBox ("This is Dateiname!")

End Sub

Private Sub Lesen_Click()
'Ausführung
'Fehlerausgang definieren
On Error GoTo Fehlerausgang

'0. Schritt: Variablen festlegen




'1. Schritt: Prüfung der Eingaben im Feld "Dateiname"




'2. Datei lesen, umarbeiten




Exit Sub
'Fehlerausgang
Fehlerausgang:
MsgBox "Fehlerhafte Eingabe oder sonst was"

End Sub

Private Sub Ende_Click()
    'Dialog schließen
    Me.Hide
End Sub


Private Sub CommandButton1_Click()
    'Me.Hide
    Unload Me
End Sub

Private Sub CommandButton2_Click()
    If filename = "" Then
        MsgBox "Ungültige Eingabe"
    Else
        Loggerdateiöffnen (filename)
        stundenwerte
        Unload Me
    End If
End Sub

Private Sub Label4_Click()

End Sub

Private Sub TextBox1_Change()
    filename = TextBox1.Text
End Sub

FUNKTION
------------------------------------------------------------------------------------------------------------------------------------------
Option Explicit
Dim VarDatei As Variant 'Kurzname der Workbookdatei



Sub Loggerdateiöffnen(DName As String)
'Öffnet die Loggerdate als Excel-Workbook und kopiert um
Dim PathElements() As String
Dim filename As String
Dim FileNameElements() As String
Dim File As String
Dim CurrentWorkbook, LoggerWorkbook As String
Dim LastUsedRow As String

CurrentWorkbook = ActiveWorkbook.name

Sheets.Add Before:=ActiveWorkbook.Sheets(1)
ActiveWorkbook.Sheets(1).name = "Strahlung"

Workbooks.Open (DName)
filename = ActiveWorkbook.name

Workbooks(filename).Worksheets(1).Range("A:A").Copy Workbooks(CurrentWorkbook).Worksheets(1).Range("A:A")
Workbooks(filename).Worksheets(1).Range("E:E").Copy Workbooks(CurrentWorkbook).Worksheets(1).Range("B:B")

Workbooks(filename).Close SaveChanges:=False

Workbooks(CurrentWorkbook).Activate

'Formatierung mit entsprechenden Einheiten
ActiveWorkbook.Worksheets("Strahlung").Range("B:B").NumberFormat = "# ##0" & Space(1) & Chr$(34) & "W/m²" & Chr$(34)


'Sonnenschein schreiben
Range("c1") = "Sonnenschein"
Dim Cell As Range

For Each Cell In ActiveWorkbook.Worksheets(1).Range("B2:B" & ActiveWorkbook.Worksheets(1).Range("B1").End(xlDown).Row)
    If Cell.Value >= 120 Then
        Cell.Offset(0, 1).Value = True
    Else
        Cell.Offset(0, 1).Value = False
    End If
Next Cell

'neues Blatt Stundenwerte anlegen, Überschriften schreiben, dann Werte eintragen

' dann Schleife wie oben, aber Ausgabe in eigenem range


End Sub

Sub stundenwerte()
'Erzeugt aus den 10-min Werten auf dem Blatt Strahlung die
'Stundenwerte auf dem Blatt Stundenwerte

'Deklarationen
Dim Zelle, DateRange As Range
Dim VarDatei As String
Dim StundenCounter, AktuelleStunde, AktuelleZeile As Integer
Dim SonnenZähler, StrahlungZähler As Variant


'Richtige DAtei aktivieren, Blatt anlegen, Überschriften schreiben
'Workbooks(VarDatei).Activate

Sheets.Add After:=ActiveWorkbook.Sheets(1)
ActiveWorkbook.Sheets(2).name = "Stundenwerte"

Range("A1").Value = "Datum/Stunden"
Range("B1").Value = "Stunde"
Range("C1").Value = "Mittlere Einstrahlung"
Range("D1").Value = "Sonnenscheindauer"
ActiveWorkbook.Worksheets("Stundenwerte").Range("A:A").NumberFormat = "dd/mm/yyyy hh"
ActiveWorkbook.Worksheets("Stundenwerte").Range("C:C").NumberFormat = "####0.0"
ActiveWorkbook.Worksheets("Stundenwerte").Range("D:D").NumberFormat = "####0.0"

ActiveWorkbook.Worksheets("Stundenwerte").Columns("A").ColumnWidth = 15
ActiveWorkbook.Worksheets("Stundenwerte").Columns("C").ColumnWidth = 20
ActiveWorkbook.Worksheets("Stundenwerte").Columns("D").ColumnWidth = 18

'Ranges festlegen
Set DateRange = ActiveWorkbook.Worksheets("Strahlung").Range("A2:A" & CStr(ActiveWorkbook.Worksheets(1).Range("A1").End(xlDown).Row))


'Umrechnen und schreiben
'Lesebereich durchlaufen und jeweils nach 6 Zeilen die summierten Werte rausschreiben
'Vielleich in etwa so: For Each Zelle In LeseRange

StundenCounter = 1
AktuelleZeile = 2
SonnenZähler = 0
For Each Zelle In DateRange
    If Zelle.Offset(0, 2).Value = True Then
        SonnenZähler = SonnenZähler + 1
    End If
    StrahlungZähler = StrahlungZähler + Zelle.Offset(0, 1).Value

    StundenCounter = StundenCounter + 1
    If StundenCounter > 6 Then
        'Zelle schreiben
        ActiveWorkbook.Worksheets(2).Range("A" & CStr(AktuelleZeile)).Value = Zelle.Value
        ActiveWorkbook.Worksheets(2).Range("B" & CStr(AktuelleZeile)).Value = DateTime.Hour(Zelle)
        ActiveWorkbook.Worksheets(2).Range("C" & CStr(AktuelleZeile)).Value = StrahlungZähler / 6
        ActiveWorkbook.Worksheets(2).Range("D" & CStr(AktuelleZeile)).Value = SonnenZähler / 6

        AktuelleZeile = AktuelleZeile + 1
        StundenCounter = 1
        StrahlungZähler = 0
        SonnenZähler = 0
    End If

Next Zelle





' Next Zelle

End Sub

Sub Form_Wm2(FBereich As Range)



End Sub



HILFSFUNKTIONEN
------------------------------------------------------------------------------------------------------------------------------------------
Option Explicit

Function kWhm2__kJcm2(Watt)
'Konvertiert Größen Wh/m² nach kJ/cm²
'Formel: 1 kJ/cm² = 2,78 kWh/m².

On Error GoTo Problem

If IsNumeric(Watt) Then

    kWhm2__kJcm2 = (Watt / 2.78)

Else

    kWhm2__kJcm2 = "Ungültige Eingabe"

End If

Exit Function

Problem:
    MsgBox "Es gab ein Problem."

End Function

Function ExistBlatt(name As String) As Boolean

    Dim Blatt As Object
    ExistBlatt = False

    For Each Blatt In ActiveWorkbook.Sheets
        If Blatt.name = name Then
            ExistBlatt = True
            Exit Function
        End If
    Next Blatt

End Function




Function ExistDatei(name As String) As Boolean

    Dim FileExists As String
    Dim Datei As Object
    ExistDate = True

    FileExists = Dir(name)

    If FileExists = "" Then
        ExistDatei = False
        Exit Function
    End If

    Next Something

End Function


WORKBOOK
------------------------------------------------------------------------------------------------------------------------------------------
Option Explicit

Private Sub Workbook_Open()
'Benutzerformular anzeigen
Load UForm1
UForm1.Show

End Sub