DAU-taugliches Excel Protokoll (inklusive Userform und VBA-Helfer)
Mein Dank geht in aller erster Linie an alle Mitglieder dieses Forums die an den Codes mitgewirkt haben!!! Vielen Dank
Dies soll eine Anleitung sein, das von mir benötigte Protokoll zu replizieren.
Aufgabe war es ein Protokoll im Medium Excel zu Erstellen und dieses mit verschiedenen Funktionalitäten zu versehen.
Anbei die verwendeten Scripte:
- Zum Daten eintragen inklusive Pflichtfelder verweis wo was eingetragen werden soll, das löschen einzelner Felder und als separate Routine das löschen aller Daten und das Eintragen in die letzte Zeile
Sub Daten_eintragen()
Dim Zeile
'CounterEintrag
Range("S6").Value = Range("S6").Value + 1
'Einträge notwendig
If [i1] <> "" And [i2] <> "" And [i4] <> "" And [i5] <> "" And [i6] <> "" And [i8] <> "" And [i9] <> "" And [i10] <> "" And [i11] <> "" And [i12] <> "" Then
'letzte benutzte Zeile ermitteln + 1
If IsEmpty(Cells(1, "E")) Then
Zeile = 1
Else
Zeile = Cells(Rows.Count, "E").End(xlUp).Row + 1
End If
'Daten eintragen
Cells(Zeile, 4) = [T7]
Cells(Zeile, 6) = [i2]
Cells(Zeile, 16) = [i3]
Cells(Zeile, 17) = [i1]
Cells(Zeile, 5) = [i4]
Cells(Zeile, 7) = [i5]
Cells(Zeile, 8) = [i6]
Cells(Zeile, 9) = [i7]
Cells(Zeile, 10) = [i8]
Cells(Zeile, 11) = [i9]
Cells(Zeile, 14) = [i10]
Cells(Zeile, 15) = [i11]
Cells(Zeile, 12) = [i12]
'Eingaben löschen
[i5:i9] = ""
[i12:i12] = ""
'letzte Zeile in sichtbaren Bereich holen
Cells(Zeile, 1).Select
End If
End Sub
- Einträge in Bereiche wieder löschen
Sub Alles_loeschen()
'Alles_loeschen Makro
[i3:i10] = ""
[i12:i12] = ""
[d2:d11] = ""
End Sub
- Suche nach Offenen Punkte mit dem heutigen Datum
ActiveSheet.AutoFilterMode = False
Const RngFilter = "N14:O10000" 'Filterbereich, 1.Zeile (14) = Überschrift
Sub SucheHück()
Dim Search1 As String
Dim Search2 As String
Search1 = Mid(Now, 1, 10)
Search2 = "offen"
If IsEmpty(Search1) Or Search1 = "" _
Or IsEmpty(Search2) Or Search2 = "" Then Exit Sub
ActiveSheet.AutoFilterMode = False
Range(RngFilter).Select
Selection.AutoFilter Field:=1, Criteria1:=CDate(Search1)
Selection.AutoFilter Field:=2, Criteria1:=Search2
Range("A1").Select
End Sub
- Versand der Mail an E-Mail Adresse
Public Sub procDateiPerMail()
Dim astrMailEmpfaenger(2) As String
If Application.MailSystem <> xlNoMailSystem Then
astrMailEmpfaenger(1) = "mailadresse@domain.de"
Application.ActiveWorkbook.SendMail _
astrMailEmpfaenger(), _
"Hier steht der Betreff", False
End If
End Sub
- suche nach einem Begriff in der Tabelle und Filtere danach (Hier:offenen Punkte/Vorgänge; Alternative: Rot/Grün, True/False usw)
ActiveSheet.AutoFilterMode = False
Const RngSearch = "O14:O10000" 'Such- und Filterbereich
Sub SucheOffen()
Dim Search As String, c As Range
Search = "offen"
ActiveSheet.AutoFilterMode = False
Set c = ActiveSheet.Range(RngSearch).Find(Search, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
c.Select: Range(RngSearch).AutoFilter Field:=1, Criteria1:=Search
End If
End Sub
- Suchefunktion mit Variablenabfrage per Messagebox
Option Explicit
ActiveSheet.AutoFilterMode = False
Const RngSearch = "D14:R5000" 'Such- und Filterbereich (H7 = Überschrift)
Sub SucheParameter()
Dim Search As String, c As Range
Search = InputBox("Bitte Suchbegriff eingeben:", "Suchen")
If Search = "" Then Exit Sub
ActiveSheet.AutoFilterMode = False
Set c = ActiveSheet.Range(RngSearch).Find(Search, LookIn:=xlValues, LookAt:=xlWhole)
If c Is Nothing Then MsgBox "Suchbegriff nicht gefunden!", vbInformation, "Suchen": Exit Sub
c.Select
Range(RngSearch).AutoFilter Field:=1, Criteria1:=Search
End Sub
- Schließe alle Filter
Sub SucheSchließen()
ActiveSheet.AutoFilterMode = False
End Sub
- Springe zu aktiven Zelle
Sub GotoActiveCell()
Application.Goto Reference:=ActiveCell
End Sub
- Hol der Cursor in den Fokus und springe 3 Zellen hoch (damit sind die letzten 2 Datensätze noch sichtbar)
Sub HolDenFokus()
Dim NextLine As Long
NextLine = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row - 2
If NextLine > 1 Then Cells(NextLine, "O").Select
End Sub
- Ganzer Bildschirm / Fullscreen
Sub AnsichtGanzerBildschirm()
Application.DisplayFullScreen = True
End Sub
Wenn das jemandem hilft, dann liebend gern...
Euer Brotherkeeper
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 131276
Url: https://administrator.de/tutorial/dau-taugliches-excel-protokoll-inklusive-userform-und-vba-helfer-131276.html
Ausgedruckt am: 24.12.2024 um 00:12 Uhr