AW: HEUTE-Formel modifizieren
03.01.2015 18:07:46
toteitote
Hi Ewald, wie lässt sich dass denn harmonisieren? Setzen der Zeit,... Muss ich ein neues Modul erstellen, die =HEUTE Zeit auf WS1 manipulieren, den Sub Kopieren()/Sub X() umschreiben?
Option Explicit
Sub Kopieren()
Dim qR As Range
Dim dR As Range
Dim zR As Range
Set qR = Application.Names("_SleepTime").RefersToRange
Set dR = Application.Names("_DayString").RefersToRange
Set zR = dR.Find(Date)
If Not zR Is Nothing Then
qR.Copy zR.Offset(1, 0)
End If
End Sub
Function Heute_2()
Dim x
x = Format(Now - 2 / 12, "DD.MM.YYYY")
Heute_2 = CDate(x)
End Function
Sub x()
Dim qR As Range
Set qR = Application.Names("_SleepTime").RefersToRange
qR.NumberFormat = "General"
qR.Clear
With qR
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With qR.Font
.Name = "Times New Roman"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
qR.Borders(xlDiagonalDown).LineStyle = xlNone
qR.Borders(xlDiagonalUp).LineStyle = xlNone
With qR.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With qR.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With qR.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With qR.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
qR.Borders(xlInsideVertical).LineStyle = xlNone
With qR.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With qR.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub