Bu forumdan aldığım devam çizelgesi bozuldu nasıl düzelir

[istanbulcahan]

Bu forumdan aldığım günlük devam çizelgesi bozuldu, Microsoft office 2013 den kaynaklanıyor, herhalde çok işimize yarıyordu. nasıl düzelir

 

[ÖmerBey]

Sayfaların başına fazladan sütun eklemişsiniz galiba onu silince bir problem yok gibi...

 

[istanbulcahan]

Herhangi bir ekleme yapmadım, halledebilirmisiniz. mümkünse.

 

[ÖmerBey]

Tam olarak nasıl çalıştığını ya da ne olması gerektiğini bilmiyorum. Ama A sütununu silince sayfadaki aktar düğmesi işlem yapıyor. Onu söylemek istedim. Devam(2) sayfasındaki A sütununu silip dener misiniz?

 

[istanbulcahan]

Aktar deyince ve A sutununu silince sonuç resimdeki giibi aynı.

 

[ÖmerBey]

İyi de siz A sütununu silmemişsiniz ki A sütunu resimde boş olarak duruyor.
Eke bakar mısınız?

 

[halit3]

Birer sutun ilave yapmışsınız.

F6 ve F7 ye kaydırmışsınız.

İlgili ayı F6 yerine E6 ya
ilgili yılı F7 yerine E7 ye yazarsanız sorun çözülür.

 

[halit3]

Veya 1 nolu mesajdaki dosyanın DEVAM(2) sayfasının kod bölümünde makroları silin aşağıdaki kodu ekliyerek deneyin.

Dim deg1 As String
Dim deg2 As String

Const aylar1 = "F6" 'AY
Const yillar1 = "F7" 'YIL

Private Sub CommandButton1_Click()
CommandButton2_Click
Dim M As Date
Dim i As Long, J As Long
Dim yer1 As String, yillar As String, aylar As String

sat1 = 10 'yazmaya başlıyacağı ilk satır
sut1 = 2 'yazmaya başlıyacağı ilk sutun

sat2 = 25 'yazmaya başlıyacağı son satır
sut2 = "L" 'yazmaya başlıyacağı son sutun


Range(Cells(sat1, sut1), Cells(sat2, sut2)).ClearContents
Range(Cells(sat1, sut1), Cells(sat2, sut2)).Interior.ColorIndex = xlNone


aylar = Range(aylar1).Value
yillar = Range(yillar1).Value

yer1 = Val(Format("01." & Format(aylar, "00") & "." & Format(yillar, "0000"), "mm"))


Ayin_Son_Gunu = DateSerial(yillar, yer1 + 1, 1) - 1
Ayin_Ilk_Gunu = DateSerial(yillar, yer1, 1)
son = Val(Format(Ayin_Son_Gunu, "dd"))

i = sat1
sut = sut1

For J = 1 To son
If J = 17 Then
sut = sut + 6
i = sat1
End If

M = CDate(Format(J, "00") & "." & Format(aylar, "00") & "." & Format(yillar, "0000"))
Hicri_takvim1 (M)
Cells(i, sut).Value = J

If Format(M, "DDDD") = "Pazar" Or Format(M, "DDDD") = "Cumartesi" Then
Cells(i, sut).Interior.ColorIndex = 8
Cells(i, sut + 1).Interior.ColorIndex = 8
Cells(i, sut + 2).Interior.ColorIndex = 8
Cells(i, sut + 3).Interior.ColorIndex = 8
Cells(i, sut + 4).Interior.ColorIndex = 8

Cells(i, sut + 1).Value = Format(M, "DDDD")
Cells(i, sut + 2).Value = Format(M, "DDDD")
Cells(i, sut + 3).Value = Format(M, "DDDD")
Cells(i, sut + 4).Value = Format(M, "DDDD")
End If
If deg1 <> "" Or deg2 <> "" Then
Cells(i, sut).Interior.ColorIndex = 8
Cells(i, sut + 1).Interior.ColorIndex = 8
Cells(i, sut + 2).Interior.ColorIndex = 8
Cells(i, sut + 3).Interior.ColorIndex = 8
Cells(i, sut + 4).Interior.ColorIndex = 8
Cells(i, sut + 1).Value = "Bayram"
Cells(i, sut + 2).Value = "Bayram"
Cells(i, sut + 3).Value = "Bayram"
Cells(i, sut + 4).Value = "Bayram"
End If
i = i + 1
Next



End Sub


Sub Hicri_takvim1(TRH)
deg2 = ""
If Month(TRH) = 1 And Day(TRH) = 1 Then deg2 = "Yılbaşı"
If Month(TRH) = 4 And Day(TRH) = 23 Then deg2 = "Ulusal Egemenlik Çocuk Bayramı"
If Month(TRH) = 5 And Day(TRH) = 1 Then deg2 = "İşçi Bayramı"
If Month(TRH) = 5 And Day(TRH) = 19 Then deg2 = "Gençlik ve Spor Bayramı"
If Month(TRH) = 8 And Day(TRH) = 30 Then deg2 = "Zafer Bayramı"
If Month(TRH) = 10 And Day(TRH) = 28 Then deg2 = "Cumhuriyetin Bayramı Yarım gün"
If Month(TRH) = 10 And Day(TRH) = 29 Then deg2 = "Cumhuriyetin Bayramı"
Calendar = vbCalHijri
deg1 = ""

If Month(TRH) = 9 And Day(TRH) = 30 Then deg1 = "Ramazan Bayramı Arife.günü Yarım gün"
If Month(TRH) = 10 And Day(TRH) = 1 Then deg1 = "Ramazan Bayramı 1.günü"
If Month(TRH) = 10 And Day(TRH) = 2 Then deg1 = "Ramazan Bayramı 2.günü"
If Month(TRH) = 10 And Day(TRH) = 3 Then deg1 = "Ramazan Bayramı 3.günü"

If Month(TRH) = 12 And Day(TRH) = 9 Then deg1 = "Kurban Bayramı Arife.günü Yarım gün"
If Month(TRH) = 12 And Day(TRH) = 10 Then deg1 = "Kurban Bayramı 1.günü"
If Month(TRH) = 12 And Day(TRH) = 11 Then deg1 = "Kurban Bayramı 2.günü"
If Month(TRH) = 12 And Day(TRH) = 12 Then deg1 = "Kurban Bayramı 3.günü"
If Month(TRH) = 12 And Day(TRH) = 13 Then deg1 = "Kurban Bayramı 4.günü"
Calendar = vbCalGreg

End Sub


Private Sub CommandButton2_Click()

aylar = Range(aylar1).Value
yillar = Range(yillar1).Value

If aylar = "" Or yillar = "" Then
MsgBox "İlgili ay veya yılı seçmediniz " & aylar1 & " veya " & yillar1 & " hücrelerine ay ve yılı yazınız."
End
End If

If IsNumeric(aylar) <> False Then
MsgBox "İlgili ayı " & aylar1 & " hücresine yazı olarak giriniz veya listeden seçiniz."
End
End If

If IsNumeric(yillar) <> True Then
MsgBox "İlgili yılı " & yillar1 & " hücresine sayısal olarak yazınız."
End
End If

gun = 0

For t = 1 To 12
yer = Format("01." & Format(t, "00") & "." & yillar, "mmmm")
If aylar = yer Then
gun = t
Exit For
End If
Next


If gun = 0 Then
MsgBox "İlgili ayı " & aylar1 & " hücresine yazı olarak ay ismi giriniz."
End
End If

If yillar < 1900 Or yillar > 2100 Then
MsgBox "Yıl için " & yillar1 & " Hücresine Lütfen 1900 - 2100 arası bir sayı giriniz."
End
End If


End Sub