Raporda Tarih Gösterme

[fedeal]

tatil günlerini göstern kod sayfanın kod bölümünde tatil yazmayla ilgili kısmını kaldırırsak olur formdaki kodlar tarihin karşısına kaydetmekte tatille ilgisi yok, değiştirmeye gerek yok yani

 

[aspuzu21]

Sayın Fedeal;
Ben bu yapılan işlemin mantığını çözmeye çalıştım ama fazla bilgim olmadığı için çözemedim.Yani yaptığınız bu çalışmada kullanılan kodların anlamlarını(ÖZELLİKLE GİRİLEN TARİHE GÖRE VERİLERİN HÜCRELERE AKTARIMI) ve nerede nasıl kullanılacağını öğrenmek istiyorum.Beni bu konu ile ilgili bilginin olduğu bir materyale yönlendirmeniz veya kullanılan kodların anlamlarını açıklamanız mümkünmüdür?Bendeki materyallerde böyle bir açıklayıcı bilgi maalesef yok.Ezbere de yapmak istemiyorum.Yardımlarınızı bekliyorum.Belki forumda vardır ama ben bulamadım malesef.
Teşekkürler.

 

[fedeal]

Private Sub CommandButton1_Click()
[COLOR="Red"]'find fonksiyonunu kullanarak a8:a65000 aralığında textbox1 i arayalım[/COLOR]
    Set C = Sheets("AYLIK ÜRETİM").Range("A8:A65000").Find(CDate(TextBox1))
    [COLOR="red"]'eğer değer yoksa hata verecektir bunun için altaki satırı kullanalım[/COLOR]
    If Not C Is Nothing Then
    [COLOR="red"]'kod üsteki değeri aştıysa demekki aradıgımız sütunda var[/COLOR]
[COLOR="red"]    'alttaki satırda sayfayı ve veriyi yazcagımız satırı tanımlıyoruz
    'b sütunu c.row (satır sayısını verecek)saatırına textbox5 i yazsın[/COLOR]
    Sheets("AYLIK ÜRETİM").Range("B" & C.Row).Value = TextBox5.Text
    Sheets("AYLIK ÜRETİM").Range("C" & C.Row).Value = TextBox6.Text
   [COLOR="red"] 'işlem bitti mesajı verdirelim[/COLOR]
    MsgBox "AKTARIM TAMAM...", , "EXCEL.WEB.TR"
    [COLOR="red"]'textboxları boşaltıp yeni veri girişine hazırlayalım[/COLOR]
     TextBox1.Text = ""
      TextBox5.Text = ""
       TextBox6.Text = ""
       [COLOR="red"]'yukarda açtığımız if sorgusunu kapatalımki hata vermesin[/COLOR]
    End If
End Sub

Private Sub TextBox1_Change()
[COLOR="red"]'textbox1 boşsa kodlar sonlanmalı yoksa hata verir.[/COLOR]
If TextBox1.Text = "" Then Exit Sub
[COLOR="red"]'textboxu tarih formatına dönüştürelim[/COLOR]
TextBox1.Text = Format(TextBox1.Text, "dd.mm.yyyy")
[COLOR="red"]'k1 hücresine tarihi yazalımki satırlara aylık bilgiler sıralansın[/COLOR]
Sheets("AYLIK ÜRETİM").Cells(1, "K").Value = TextBox1.Text
End Sub

Private Sub TextBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
[COLOR="red"]'textboxun üzerine maus gelince takvim açılsın[/COLOR]
UserForm2.Show 0
End Sub

userform1 in tüm kodlarını açıklamayı çalıştım anlamadıgınız yeri sorabilirsiniz.

 

[aspuzu21]

Tekrar Merhaba.
Açıklamalar çok süper olmuş çok faydalandım.Ben kendim yeni bir düzenleme yapmak istedim.Hatırlarsanız Necdet Bey koşullu biçimlendirme ile bir çalışma yapmıştı.Ben o çalışmaya bu uylamayı entegre etmeye çalıştım.Fakat bazı hatalarla karşılaştım.
Şöyle ki;

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("K1")) Is Nothing Then Exit Sub
Cells(8, 1).Value = DateValue(1 & "." & Cells(1, 1) & "." & Cells(1, 2))
Cells(8, 11).Value = "=IF(INT(RC[-10])-(INT(RC[-10]/7)*7)=1,""TATİL"",IF(ISERROR(INDEX(C[16],MATCH(RC[-10],C[16],0),1)),"""",""TATİL""))"
Range("A8").Select
Selection.AutoFill Destination:=Range("A8:A38"), Type:=xlFillDefault
Range("K8").Select
Selection.AutoFill Destination:=Range("K8:K38"), Type:=xlFillDefault
For A = 8 To 38
Cells(A, 11).Value = Cells(A, 11).Value
Next
Range("K4").Value = "=COUNTIF(R[4]C:R[34]C,""TATİL"")"
Range("K4").Value = Range("K4").Value
End Sub

kırmızı ile gösterilen hata ile karşılaştım.Nasıl çözeriz acaba???
Valla sayenizde epey bilgi sahibi oldum. Çok çok sağolun

 

[fedeal]

necdet beyin çalışmasında hatırladıgım kadarıyla a1 b1 hücresi birleşik ve direkt tarih vardı.bu durumda bu kodda datevalue içine aldıgımız deger hata verir. çünkü biz o satırda a1 hücresinde ay yazıyor b1 hücresinde yıl ayın ilk gününü bulmak için
1 & "." & cells(1,1) 'ay & "." & cells(1,2) 'yıl
yazmıştık.
şimdi şöyle yapalımki düzelsin

ay = Month(cells(1,1).value)
yıl = Year(cells(1,1).value)
Cells(8, 1).Value = DateValue(1 & "." & ay & "." & yıl)

hata veren satırın yerine yazın

 

[aspuzu21]

Çok sağolun hocam valla siz bu işin gerçekten uzmanısınız.Dediğinizi yazdım ve sorun çözüldü.
Ama şimdi başka bir sorun çıkıyor:Eğer textboxa tarih girilmez ise hata ekranı çıkıyor şu şekilde

Private Sub CommandButton1_Click()
'On Error Resume Next
Set C = Sheets("AYLIK ÜRETİM").Range("A8:A65000").Find(CDate(TextBox1))
If Not C Is Nothing Then
Sheets("AYLIK ÜRETİM").Range("B" & C.Row).Value = TextBox5.Text
Sheets("AYLIK ÜRETİM").Range("C" & C.Row).Value = TextBox6.Text
MsgBox "AKTARIM TAMAM...", , "EXCEL.WEB.TR"
TextBox1.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
End If
End Sub

kırmızı ile belirttiğim satırı işaret ediyor.

 

[fedeal]

onun için calendarla tarih girişini yapmıştım textbox1 boşsa hata veriyorsa
if textbox1="" then exit sub
kodların başına ilave edin
'On Error Resume Next
satırının başındaki tırnagıda kaldırın hata verirse atlayacaktır bu şekilde textbox1 tarih olmayınca kod çalışmayacaktır.

 

[aspuzu21]

Sayın hocam çok çok teşekkürler.Son bir sorum olabilir mi sizi sıkmadıysam.Ben bir ara vardiya oluşturma programı yapmıştım .Sizin takvimi uygulamak istedim fakat takvim userforma geliyor ama işlem yapmıyor.Uygulamada bir hata yaptıyorum çözemedim son bir yardımınız olursa rica etsem dosya ektedir.Yanlız tarih girilirken vardiya 1 haftalık olduğundan şöyle tarih oluşmalı ilgili satırda 11-13 temmuz 2009 .
Saygılarımla.

 

[fedeal]

kodları uyarlarken
Private Sub UserForm1_Initialize()
olarak yazmışsınız 1 olmaz aynı şekilde activatedede
Private Sub Calendar1_Click() ide
Private Sub Calendar_Click() olarak yazmışsınız
birde
UserForm1.TextBox1.Text = Format(Calendar1.Value, "dd.mm.yyyy")
satırı
UserForm2.TextBox1.Text = Format(Calendar1.Value, "dd.mm.yyyy")
olmalı doğrusu aşağıda,iyi geceler.

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
              (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal HWND As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HWND As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal HWND As Long) As Long
Private TitleBarState As String
Public Property Get HWND() As Long
HWND = FindWindow(lpClassName:=IIf(Val(Application.Version) > 8, "ThunderDFrame", "ThunderXFrame"), lpWindowName:=Me.Caption)
End Property
Private Sub Calendar1_Click()
UserForm2.TextBox1.Text = Format(Calendar1.Value, "dd.mm.yyyy")
Unload Me
End Sub
Private Sub UserForm_Activate()
For A = 0 To 176.25 Step 0.05
DoEvents
Me.Height = A
Next
End Sub



Private Sub UserForm_Initialize()
Dim Userform1_Style As Long
Const GWL_STYLE = (-16)
Const WS_CAPTION = &HC00000
Userform1_Style = GetWindowLong(HWND:=Me.HWND, nIndex:=GWL_STYLE)
If bShow = True Then
Userform1_Style = Userform1_Style Or WS_CAPTION
Else
Userform1_Style = Userform1_Style And Not WS_CAPTION
End If
Call SetWindowLong(HWND:=Me.HWND, nIndex:=GWL_STYLE, dwNewLong:=Userform_Style)
Call DrawMenuBar(HWND:=Me.HWND)
Calendar1.Value = Date
Me.Height = 0
End Sub

 

[aspuzu21]

Çok Çok teşekkürler Sayın Hocam. Allah razı olsun sizden.Emeğinize sağlık.Artık programı oluşturmaya başlıyım yarından itibaren.
Saygılar sevgiler.İyi geceler.

 

[aspuzu21]

kafama takılan bişey var kırmızı satırda yazılana göre başka sayfalara bu sayfadan veri alacaksınız ve formülle ancak bu sayfa degişince örnegin aralık olunca veriler değişecek tabi formülle verileri aldıgınız sayfadaki verilerde hata oluşmayacakmı ?

Sayın Fedeal ve diğer değerli Hocalarım; Ben bu konuda bir şey yapamadım.Aklıma başka bir yol geldi ama tabi ki de uygulayabilmek için bilgi lazım.Bende de o yok.Yeni yüklediğim dosyayı bir incelermisiniz? Yapmak istediğim çalışma uygun olur mu bu konu için?

 

[aspuzu21]

Cevap gelmedi.Heralde ben bu projeyi gerçekleştiremeyeceğim...