title image


Smiley Re: NICHT Wunderbar, weil...
Hallo Torsten,Wie waehre es mal mit einem Blick in die Hilfe, dann wuerden sich solche Fragen von selbst erledigen.Weshalb eigentlich so umstaendlich und den User fragen,welcher Wochentag der Monatserste ist und welcher Tag der Monatsletzte. Wenn man eine Anwendung programmiert sollte man auch etwas ueber Anwenderfreundlichkeit nachdenken.Bei Deinem Vorgehen muss man erst wieder einen Kalender zur Hand haben um weiter zukommen!!!Excel kann das selbst erledigen.Nachfolgend der Code dafuer:Option ExplicitConst strWorksheet = "Sheet1"Const rngCell = "E3"' wenn es bei Deutschem Excel nicht funktioniert' hier ggf. das Format in "tt-mmm-jjjj" bzw. "ttt" aendernConst strFormat = "dd-mmm-yyyy"Const strDay = "ddd"Sub DaysOfMonth() Dim MonthInput As Integer Dim YearInput As Integer Dim DateStart As Date Dim DateEnd As Date Dim DatePut As Date Dim TheDay As Integer Dim TheMonth As Integer Dim TheYear As Integer 'Mit Type 1 sind nur Zahlen als Eingabe zugelassen. MonthInput = Application.InputBox(Prompt:="Bitte geben Sie einen Monat (Zahl) an.", Type:=1) YearInput = Application.InputBox(Prompt:="Bitte geben Sie das Jahr (4-stellig) an.", Type:=1) If Not CheckMonth(MonthInput, YearInput) Then MsgBox "Kein gültiger Monat bzw. Jahr angegeben", vbExclamation, "Auswertung Monat & Jahr" Else DateStart = DateSerial(YearInput, MonthInput, 1) If MonthInput 12 Then DateEnd = DateSerial(YearInput, MonthInput + 1, 1) DateEnd = DateEnd - 1 Else DateEnd = DateSerial(YearInput + 1, 1, 1) DateEnd = DateEnd - 1 End If TheDay = Day(DateStart) TheMonth = Month(DateStart) TheYear = Year(DateStart) With ThisWorkbook.Sheets(strWorksheet) Range(rngCell).Activate For DatePut = DateStart To DateEnd Step 1 DatePut = DateSerial(TheYear, TheMonth, TheDay) ActiveCell.Offset(0, TheDay).Value = Format(DatePut, strFormat) ActiveCell.Offset(1, TheDay).Value = Format(DatePut, strDay) TheDay = TheDay + 1 Next DatePut End With End IfEnd SubPrivate Function CheckMonth(WhichMonth As Integer, WhichYear As Integer) As Boolean CheckMonth = False If WhichYear 2099 Then Exit Function Else Select Case WhichMonth Case 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 CheckMonth = True End Select End IfEnd FunctionViele GruesseNorbert

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: