VBA-Software - GVXnet

Direkt zum Seiteninhalt

VBA-Software

Software
Option Explicit

Sub DatumInZellenSchreiben()
'
' Selektierter Bereich wird mit aktuellem Datum und Zeit als fester Text beschrieben. Nicht wie bei der Tastenkombination "STRG+."
' VBA Funktionen können nicht rückgängig gemacht werden, deshalb sollte man vorher das workbook speichern
' Die Speicherung erfolgt automatisch bevor ein Array befüllt werden soll
' Arrays existieren z.B. wenn eine ganze Zeile markiert ist, deshalb wird auf Array abgefragt und nicht auf mehrere ausgewählte Zellen
' Für die Abfrage auf mehrere nicht zusammenhängende Zellen kann "Selection.Count > 1" verwendet werden
' Now - aktuelles Datum & Zeit
' Format(Now, "yymmddhhmmss")

  Dim strDatumFuellen_Antwort As String      ' Antwort der Messagebox mit Auswahl
  Dim bolFillCells As Boolean                ' Wenn true dann soll die Zelle gefüllt werden
   
  strDatumFuellen_Antwort = ""
  bolFillCells = False
      
  ' Ein Feld oder mehrere einzelne Felder ausgewählt ?
  If IsArray(Selection) = False Then bolFillCells = True

  If IsArray(Selection) = True Then       ' Wenn ein Array ausgewählt ist, nachfragen ob es gefüllt werden soll
      strDatumFuellen_Antwort = MsgBox("Aktuelles Datum in ein Array einfügen?", 1) ' Requester mit Ja/Abbruch
      
      If strDatumFuellen_Antwort = 1 Then bolFillCells = True ' wenn "Ja"
                
  End If
 
 If bolFillCells = True Then
      SaveActiveWorkbookCopy                 ' Kopie der Datei speichern
      Feldinhalt_In_Kommentare_Selection_NOW ' Text in Kommentare anschließend mit "NOW" füllen
 End If

End Sub

Sub Feldinhalt_In_Kommentare_Selection_NOW()
' Der Inhalt des aktuellen Feldes wird in ein Kommentar geschrieben
' Das Feld wird mit aktuellem Datum und Zeit beschrieben
' Aufruf der Funktion HiddenCells(rngcells) as boolean, mit dem Parameter der aktiven Zelle ob Zelle sichtbar oder versteckt
' Abfrage ob aktuelle Zelle sichtbar, Rückgabeparamter Wahr für sichtbar

  Dim rngCells As Range
  Dim strUsername As String
  
  strUsername = Environ("username")
  
  AutoUpdate_OFF
  
  For Each rngCells In Selection
  
    If HiddenCells(rngCells) = False Then
  
      If rngCells.Value = "" Then
          rngCells.Value = Now
          Else
  
          If rngCells.Comment Is Nothing Then ' Kommentar nicht vorhanden
              rngCells.AddComment
              rngCells.Comment.Visible = False
              rngCells.Comment.Text Text:=strUsername & ":" & Chr(10) & rngCells.Value
              rngCells.Value = Now
              Else
              
                  If Not rngCells Is Nothing Then ' Kommentar vorhanden
                      rngCells.Comment.Visible = False
                      rngCells.Comment.Text Text:=strUsername & ":" & Chr(10) & rngCells.Value & ";" & Chr(10) & rngCells.Comment.Text
                      rngCells.Value = Now
                  End If
          End If
      End If
   End If
  Next
  
  AutoUpdate_ON

End Sub

Function HiddenCells(rngCells As Range) As Boolean
' gibt den Boolwert "TRUE" zurück wenn die aktive Zelle augeblendet ist

  HiddenCells = False
  
  If rngCells.EntireRow.Hidden = True Then HiddenCells = True
  If rngCells.EntireColumn.Hidden = True Then HiddenCells = True

End Function

Sub AutoUpdate_ON()

  Application.Calculation = xlAutomatic
  Application.ScreenUpdating = True

End Sub
Sub AutoUpdate_OFF()

  Application.Calculation = xlManual
  Application.ScreenUpdating = False
End Sub
Zurück zum Seiteninhalt