Inputbox yılı yaz, ayları sayfa olarak eklesin Hazır Excel Makroları (VBA) | Excel Programları

Makroyu Kopyala

'Excel Makro (VBA) online eğitimleri için: https://www.excelsizeyeter.com/excelsizeyeter.com/udemy_giris.php adresine tıklayınız. Bir eğitim alana bir eğitim bedavadır. İkinci eğitim olarak Excel, Excel pratik çözümler, finans eğitimleri vb. alabilirsiniz. 
 
Sub Jahreskalender()
Dim strJahr As String
Dim lngNumSheets As Long
Dim intI As Integer, intJahr As Integer

strJahr = InputBox("Kalender anlegen für Jahr:", , Year(Date))
If strJahr = "" Or Not IsNumeric(strJahr) Then Exit Sub
intJahr = CInt(strJahr)

lngNumSheets = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 12
Workbooks.Add
Application.SheetsInNewWorkbook = lngNumSheets
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Windows(1).Caption = "Jahreskalender " & strJahr

For intI = 1 To 12
Worksheets(intI).Activate
Call MonatAnlegen(intJahr, intI)
Next intI

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Private Sub MonatAnlegen(intJahr As Integer, intMonat As Integer)
Dim intI As Integer
Dim lngDate As Long

lngDate = CLng(DateSerial(intJahr, intMonat, 1))
ActiveSheet.Name = Format(lngDate, "mmmm") 'zB "Januar"

Range("A1") = "Datum"
Range("C1") = "Eintragung"
Range("D1") = "Geburtstage"
With Range("A1:D1")
With .Font
.Bold = True
.Size = 10
.ColorIndex = 6
End With
.Interior.ColorIndex = 11
End With

intI = DateSerial(intJahr, intMonat + 1, 1) - lngDate + 1
Range("A2") = lngDate
Range("A3").Formula = "=A2+1"
Range("A3:A" & intI).FillDown
Range("A2:A" & intI).Copy
Range("A2:A" & intI).PasteSpecial (xlValues)
Range("A2:A" & intI).NumberFormat = "dd.mm.yy"
Columns(1).Copy Columns(2)
Range("B1") = "Tag"
Range("B1").HorizontalAlignment = xlRight
Range("B2:B" & intI).NumberFormat = "dddd" 'zB "Samstag"

Range("C2").Select
intI = 2
Do Until IsEmpty(Cells(intI, 1))
Select Case Weekday(Cells(intI, 1))
Case vbSaturday
Range(Cells(intI, 1), Cells(intI, 2)).Interior.ColorIndex = 40 'Orange
Case vbSunday
Range(Cells(intI, 1), Cells(intI, 2)).Interior.ColorIndex = 3 'Rot
End Select
Cells(intI, 3).Value = Feiertag(Cells(intI, 1).Value)
intI = intI + 1
Loop
ActiveSheet.UsedRange.Columns.AutoFit
End Sub

'http://home.t-online.de/home/t.igel/xlostern.htm
Private Function Feiertag(datum As Long) As String
Dim temp As Variant
Feiertag = ""
Select Case Month(datum)
Case 1
Select Case Day(datum)
Case 1
Feiertag = "Neujahr"
Case 6
Feiertag = "Heiligen 3 Könige"
End Select
Case 2 To 6
osSo = OsterSo(Year(datum))
Select Case datum
Case osSo - 48
Feiertag = "Rosenmontag"
Case osSo - 47
Feiertag = "Fasching"
Case osSo - 46
Feiertag = "Aschermittwoch"
Case osSo - 2
Feiertag = "Karfreitag"
Case osSo - 1
Feiertag = "Karsamstag"
Case osSo
Feiertag = "Ostersonntag"
Case osSo + 1
Feiertag = "Ostermontag"
Case DateSerial(Year(datum), 5, 1)
Feiertag = "Tag der Arbeit"
Case osSo + 39
Feiertag = "Christi Himmelfahrt"
Case osSo + 48
Feiertag = "Pfingstsamstag"
Case osSo + 49
Feiertag = "Pfingstsonntag"
Case osSo + 50
Feiertag = "Pfingstmontag"
Case osSo + 60
Feiertag = "Fronleichnam"
End Select
Case 8
Select Case Day(datum)
Case 15
Feiertag = "Maria Himmelfahrt"
End Select
Case 10
Select Case Day(datum)
Case 3
Feiertag = "Tag der Dt. Einheit"
End Select
Case 11
temp = DateSerial(Year(datum), 12, 25)
Select Case datum
Case DateSerial(Year(datum), 11, 1)
Feiertag = "Allerheiligen"
Case (temp - Weekday(temp, vbMonday) - 32)
Feiertag = "Buß- und Bettag"
End Select
Case 12
Select Case Day(datum)
Case 24
Feiertag = "Heilig Abend"
Case 25
Feiertag = "1. Weihnachtsfeiertag"
Case 26
Feiertag = "2. Weihnachtsfeiertag"
Case 31
Feiertag = "Silvester"
End Select
End Select
End Function

Private Function OsterSo(jahr As Integer) As Variant
Dim d As Variant
d = (((255 - 11 * (jahr Mod 19)) - 21) Mod 30) + 21
OsterSo = DateSerial(jahr, 3, 1) + d + (d > 48) + _
6 - ((jahr + jahr  4 + d + (d > 48) + 1) Mod 7)
End Function

Benzer Sonuçlar
No	Makro Adı
1	Inputbox yılı yaz, ayları sayfa olarak eklesin
2	ayları sayfa olarak ekler günleri ayrıntılı olarak belirtir
3	yılı yaz sayfalara ayları ekler
4	tarihi tam gir o tarihten sonraki ve o yıl içerisindeki haftaları sayfa olarak eklesin
5	word sayfası olarak çıktı almak
6	Seri Numaraları Ekleme: Bu makro kodu, excel sayfanıza seri numaraları otomatik olarak eklemenize yardımcı olacaktır. Bu makroyu çalıştırdıktan sonra seri numaralar için maksimum sayı girmeniz gereken bir giriş kutusu gösterecektir ve bundan sonra bir sütundaki sütuna sayı ekleyecektir.
7	Inputbox ile aktif hücreye açıklama ekleme
8	sayfalara şifre koymak
9	Özel Sayfaları Yazdır: Yazdırma seçeneklerinden ayarı kullanmak yerine, bu kodu, özel sayfa aralığı yazdırmak için kullanabilirsiniz. 5 ila 10 arasındaki sayfaları yazdırmak istediğinizi varsayalım. Sadece bu VBA kodunu çalıştırmanız ve başlangıç sayfası ve bitiş sayfasını girmeniz yeterlidir.
10	sayfa sekmelerine koruma atamak
11	Birden Çok Çalışma Sayfası Ekle: İş kitabınızda tek bir puntoda birden çok çalışma sayfası eklemek istiyorsanız bu kodu kullanabilirsiniz. Bu makro kodunu çalıştırdığınızda, girmek istediğiniz toplam sayfa sayısını girmek için bir giriş kutusu alırsınız.
12	ayları sayfa olarak ekler ayın günlerini de yazar ve aktif ay ve güne gider
13	sayfa silme inputbox'a yazarak
14	Inputbox içine yazilan karakterler "*****" (password veya şifre karakterleri) şeklinde çikabilir mi?
15	ayları sayfa olarak ekleme
16	Inputbox'la sayfa bulma
17	b3e veri gir entere bas sayfa olarak eklesin
18	dosyayı sizden başkası kaydetmesin
19	ayları sayfa olarak ekler ve o güne gider
20	2.sütunda çift tıkla eklenecek satırı belirle

Benzer Sonuçlar

Makro Adı

Inputbox yılı yaz, ayları sayfa olarak eklesin

ayları sayfa olarak ekler günleri ayrıntılı olarak belirtir

yılı yaz sayfalara ayları ekler

tarihi tam gir o tarihten sonraki ve o yıl içerisindeki haftaları sayfa olarak eklesin

word sayfası olarak çıktı almak

Seri Numaraları Ekleme: Bu makro kodu, excel sayfanıza seri numaraları otomatik olarak eklemenize yardımcı olacaktır. Bu makroyu çalıştırdıktan sonra seri numaralar için maksimum sayı girmeniz gereken bir giriş kutusu gösterecektir ve bundan sonra bir sütundaki sütuna sayı ekleyecektir.

Inputbox ile aktif hücreye açıklama ekleme

sayfalara şifre koymak

Özel Sayfaları Yazdır: Yazdırma seçeneklerinden ayarı kullanmak yerine, bu kodu, özel sayfa aralığı yazdırmak için kullanabilirsiniz. 5 ila 10 arasındaki sayfaları yazdırmak istediğinizi varsayalım. Sadece bu VBA kodunu çalıştırmanız ve başlangıç sayfası ve bitiş sayfasını girmeniz yeterlidir.

sayfa sekmelerine koruma atamak