Soru Aynı Klasördeki başka bir dosyadan bir alanı seçip yapıştırma

vurkan · 18 Temmuz 2018

Arkadaşlar Merhaba Öğretmenlerin ihtiyaç duyduğu Kazanım Değerlendirme Ölçeği Programı yapmaya çalışıyorum. İşi oldukça kolay hale getirdim. e-okul programından ders notlarını excele aktarıyoruz. Aktardığımız bu dosyaya sınıfın adını veriyoruz. Örneğin 2A Sonra bu dosyayı açıp içindekileri seçip benim hazırladığım program dosyasının SINIF sayfasına C12 den itibaren yapıştırıyoruz. Gerekli yerleri doldurduktan sonra çıktı alıyoruz.

Ancak yardım istediğim konu;

Ekte sunduğum 2018 KAZANIM 2. SINIF dosyasının SINIF sayfasında F10 hücresine 2A yazınca Aynı klasör içindeki 2A adlı dosyayı açıp (veya açmadan) A3:Z aralığını B sütunundaki son satıra kadar kopyalayıp C12 den itibaren yapıştıracak bir kod istiyorum. F10 hücresi boşaltıldığında veya değiştirildiğinde F10 daki sınıf ismini dosya adının ardına ilave ederek (mesela 2018 KAZANIM 2A şeklinde) aynı klasöre farklı kaydedip C12 den itibaren eski bilgileri temizlemesini istiyorum. Böylece f10 hücresine yazılan sınıf adlarına göre işlem yapmalı.

http://www.dosya.tc/server14/rz1e56/2018_KAZANIM_OLCEKLERI.rar.html

vurkan · 19 Temmuz 2018

Arkadaşlar sorum mu anlaşılamadı acaba. İstediğim şey aktif çalışma kitabımın F10 hücresine yazdığım isimle aynı olan dosyanın açılarak açılan dosyanın A3:Z aralığını B sütunundaki son satıra kadar kopyalayıp aktif kitaptaki C12 hücresinden itibaren yapıştıracak bir kod.

PLİNT · 20 Temmuz 2018

Merhaba
Ek dosyayı deneyin.
"F10" hücresine sınıf adı yazdığınızda verileri alacak, silmek veya yeni sınıf adı girmek için tekrar "F10" hücresi seçildiğinde sayfadaki bilgiler farklı dosya olarak kaydedilecektir.
http://s3.dosya.tc/server16/4k0bsk/Klasor.zip.html

vurkan · 20 Temmuz 2018

Sayın plint cevabınızı cep telefonundan gördüm. Bir iki gün içinde deneme fırsatı bulurum inşallah. Teşekkür ederim.

vurkan · 22 Temmuz 2018

Sayın Plint Hazırladığınız çalışmayı henüz inceleyebildim. Tam düşündüğüm gibi olmuş. Ancak bir şey farkettim. Şöyle ki; sınıf adını 2a gibi yazdım. kodlar normal çalıştı ancak a harfini büyüteyim diye F10 tıklayınca normal olarak sınıfı farklı kaydetti. Şimdi:
Acaba kodları ikiye bölüp iki butona bağlasak birisiyle birinci bölümü çalıştırsak, ikincisiyle tabloyu temizlerken farklı kaydetsek nasıl olur acaba? Çok teşekkür ederim.

vurkan · 22 Temmuz 2018

Tekrar merhaba. 1., 2. ve 3. sınıfların gerçek dosyalarında sorunsuz çalışan kodlar 4. sınıfların dosyasına uyarladığımda bütün dolu sütunların en son satırın bir alt satırına #YOK yazıyor. Dolayısıyla diğer sayfalardaki dizi formüllerim çalışmıyor. 4. Sınıflarda rakamsal notlar var. Almak istediğim öğretmen ismi E sütununda. Kodlarda B sütunu son satırı E ile değiştirdim. Ama yine de düzelmedi. Bu sorunu nasıl aşabiliriz acaba?

http://s7.dosya.tc/server8/1siqam/4.siniflar.rar.html

İlgilenecek olanlara şimdiden çok çok teşekkür ediyorum.

vurkan · 22 Temmuz 2018

Merhaba arkadaşlar ilgilenenler için 6 nolu mesajımdaki 4. sınıflarla ilgili sorunu;

Range("C12:AB" & x + 9).Value = a.Worksheets(1).Range("A4:AB" & x).Value satırındaki +9 rakamını +8 ile değiştirerek çözdüm

Range("C12:AB" & x + 8).Value = a.Worksheets(1).Range("A4:AB" & x).Value.

5 nolu mesajımdaki buton isteği devam ediyor saygılarımla.

PLİNT · 23 Temmuz 2018

vurkan' Alıntı:
Şöyle ki; sınıf adını 2a gibi yazdım. kodlar normal çalıştı ancak a harfini büyüteyim diye F10 tıklayınca normal olarak sınıfı farklı kaydetti

Merhaba
3. mesajdaki dosyada; "F10" hücresindeki küçük harf yazma sorunu kodlara yapılacak ekleme ile çözülebilir.

vurkan' Alıntı:
5 nolu mesajımdaki buton isteği devam ediyor

Butonlu örnek dosya ektedir.

http://s7.dosya.tc/server8/zsbmto/4.siniflar_2.zip.html

vurkan · 23 Temmuz 2018

Sayın Plint teşekkür ederim. Yeni dosyaları hemen inceleyeceğim. Ancak; yeni bir sorunum daha gelişti. Şöyle ki ; İngilizce ve Din dersi gibi branş derslerinde F10 hücresine 2A gibi sınıf yerine DİN gibi branşın ismini yazdım. Birinci bölüm kodları çalıştı ancak tekrar F10 hücresine tıklayınca yedekleme yapmadı

vurkan · 24 Temmuz 2018

Arkadaşlar merhaba. 9 nolu mesajımdaki olumsuzluğu Sayın Plint'in 8 nolu mesajındaki yöntemle aştım. Böylece sorunum % 90 tamamlandı.

Eğer mümkünse aşağıdaki kodlara nasıl bir ilave yapalım ki aktif kitabın "LİSTE, SINIF, OKUL" isimli sayfalarının dışında kalan sayfaları yedeklesin.
Ve eğer mümkün ise sayfa şekilleri aynı kalmakla birlikte formülleri değilde değerleri kopyalasın.
Çünkü Yedek dosya açılırken bağlantıları güncellemekten bahsediyor. Güncelleştirme diyerek açtığımda formüller çalışmadığından (herhalde) tüm yazılar #DEĞER! şeklinde oluyor. Bu dosyayı elektronik ortamda okul idaresine verince problem yaşanabilir. Saygılar.

Sub kaydet_temizle()
Dim s1 As Worksheet, s As Long, kayıt As String, yol As String
Dim deg As String, ad As String
Dim f As Object
Set s1 = Sheets("BRANŞ")
s1.Range("F10").Value = UCase(Replace(Replace(s1.Range("F10").Value, "ı", "I"), "i", "İ"))
deg = s1.Range("F10").Value
If deg <> "" And s1.Cells(Rows.Count, "C").End(3).Row > 11 Then
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'On Error GoTo fr
Set f = CreateObject("scripting.filesystemobject")
yol = ThisWorkbook.Path & "\"
If f.FolderExists(yol & "Yedek Dosyalar") = False Then f.CreateFolder yol & "Yedek Dosyalar"
ad = f.GetBaseName(ThisWorkbook.Name) & " " & deg
kayıt = yol & "Yedek Dosyalar\" & ad & ".xls"

Workbooks.Add 1
For s = 1 To ThisWorkbook.Sheets.Count
If ThisWorkbook.Sheets.Count <> ActiveWorkbook.Sheets.Count Then ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ThisWorkbook.Sheets(s).Cells.Copy
ActiveWorkbook.Sheets(s).PasteSpecial
Application.CutCopyMode = False
ActiveWorkbook.Sheets(s).Name = ThisWorkbook.Sheets(s).Name
Next
Application.DisplayAlerts = False
ChDir yol & "Yedek Dosyalar\"
ActiveWorkbook.Sheets(1).Activate
ActiveWorkbook.SaveAs Filename:=kayıt, FileFormat:=56
ActiveWorkbook.Close savechanges:=False
MsgBox ad & " dosyası " & vbCrLf & yol & "Yedek Dosyalar Klasörüne kaydedildi"
Application.DisplayAlerts = True
End If
fr:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
On Error Resume Next
s1.Range("C12:AE1000").SpecialCells(xlCellTypeConstants, 23).ClearContents
s1.Range("F10") = ""
End Sub

askm · 24 Temmuz 2018

Yanlış anlamamışsam aşağıdaki şekilde olması gerek.

Kod:

Sub kaydet_temizle()
Dim s1 As Worksheet, s As Long, kayıt As String, yol As String
Dim deg As String, ad As String
Dim f As Object
Set s1 = Sheets("SINIF")
's1.Range("F10").Value = UCase(Replace(Replace(s1.Range("F10").Value, "ı", "I"), "i", "İ"))
deg = s1.Range("F10").Value
If deg <> "" And s1.Cells(Rows.Count, "C").End(3).Row > 11 Then
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'On Error GoTo fr
Set f = CreateObject("scripting.filesystemobject")
yol = ThisWorkbook.Path & "\"
If f.FolderExists(yol & "Yedek Dosyalar") = False Then f.CreateFolder yol & "Yedek Dosyalar"
 ad = f.GetBaseName(ThisWorkbook.Name) & " " & deg
kayıt = yol & "Yedek Dosyalar\" & ad & ".xls"

Workbooks.Add 1
For s = 1 To ThisWorkbook.Sheets.Count
SayfaAdi = ThisWorkbook.Sheets(s).Name
If SayfaAdi <> "LİSTE" And SayfaAdi <> "SINIF" And SayfaAdi <> "OKUL" Then
If ThisWorkbook.Sheets.Count <> ActiveWorkbook.Sheets.Count Then ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ThisWorkbook.Sheets(s).Cells.Copy
ActiveWorkbook.Sheets(s).PasteSpecial
Application.CutCopyMode = False
ActiveWorkbook.Sheets(s).Name = ThisWorkbook.Sheets(s).Name
End If
Next
Application.DisplayAlerts = False
    ChDir yol & "Yedek Dosyalar\"
    ActiveWorkbook.Sheets(1).Activate
    ActiveWorkbook.SaveAs Filename:=kayıt, FileFormat:=56
    ActiveWorkbook.Close savechanges:=False
MsgBox ad & " dosyası " & vbCrLf & yol & "Yedek Dosyalar Klasörüne kaydedildi"
    Application.DisplayAlerts = True

End If
fr:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
On Error Resume Next
    s1.Range("C12:AE1000").SpecialCells(xlCellTypeConstants, 23).ClearContents
    s1.Range("F10") = ""
End Sub

vurkan · 24 Temmuz 2018

Sayın Askm ilgin için teşekkür ederim. Kodları çalıştırınca

ActiveWorkbook.Sheets(s).PasteSpecial

satırında hata mesajı verdi.

askm · 24 Temmuz 2018

Sizin 10. mesajda eklediğiniz kodda belirtilen sayfa mevcut değil. F10 hücresi dolu olarak örnek dosyanızı eklerseniz dosyanızı çalışır vaziyette tekrar atmaya çalışırım.

vurkan · 24 Temmuz 2018

Merhaba dosyaları ekledim. 2019 KAZANIM DİN1 dosyasının BRANŞ sayfasının F10 hücresine DİN yazarak DİN dosyasındaki bilgileri alıyoruz.

http://www.dosya.tc/server14/0ziahw/TAMAMLANAN.rar.html

askm · 24 Temmuz 2018

Dosyanız ektedir.

Kod:

Sub kaydet_temizle()
Dim s1 As Worksheet, s As Long, kayıt As String, yol As String
Dim deg As String, ad As String
Dim f As Object
Set s1 = Sheets("SINIF")
's1.Range("F10").Value = UCase(Replace(Replace(s1.Range("F10").Value, "ı", "I"), "i", "İ"))
deg = s1.Range("F10").Value
If deg <> "" And s1.Cells(Rows.Count, "C").End(3).Row > 11 Then
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'On Error GoTo fr
Set f = CreateObject("scripting.filesystemobject")
yol = ThisWorkbook.Path & "\"
If f.FolderExists(yol & "Yedek Dosyalar") = False Then f.CreateFolder yol & "Yedek Dosyalar"
 ad = f.GetBaseName(ThisWorkbook.Name) & " " & deg
kayıt = yol & "Yedek Dosyalar\" & ad & ".xls"
a = 1
Workbooks.Add 1
For s = 1 To ThisWorkbook.Sheets.Count
SayfaAdi = ThisWorkbook.Sheets(s).Name
If SayfaAdi <> "LİSTE" And SayfaAdi <> "SINIF" And SayfaAdi <> "OKUL" Then
a = a + 1
If ThisWorkbook.Sheets.Count <> ActiveWorkbook.Sheets.Count Then ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ThisWorkbook.Sheets(s).Cells.Copy
ActiveWorkbook.Sheets(a).PasteSpecial
Application.CutCopyMode = False
ActiveWorkbook.Sheets(a).Name = ThisWorkbook.Sheets(s).Name
End If
Next
Application.DisplayAlerts = False
    ChDir yol & "Yedek Dosyalar\"
    ActiveWorkbook.Sheets(1).Activate
    ActiveWorkbook.SaveAs Filename:=kayıt, FileFormat:=56
    ActiveWorkbook.Close savechanges:=False
MsgBox ad & " dosyası " & vbCrLf & yol & "Yedek Dosyalar Klasörüne kaydedildi"
    Application.DisplayAlerts = True

End If
fr:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
On Error Resume Next
    s1.Range("C12:AE1000").SpecialCells(xlCellTypeConstants, 23).ClearContents
    s1.Range("F10") = ""
End Sub

vurkan · 24 Temmuz 2018

Sayın Askm altın üye olmadığım için ekli dosyayı alamadım. Ancak kodları kopyalayıp denediğimde;

ActiveWorkbook.SaveAs Filename:=kayıt, FileFormat:=56

Satırında hata verdi.

askm · 25 Temmuz 2018

Sorununuz deg değişkeninde. Yani Sınıf sayfası F10 hücresinden aldığı değerde. Burada '/' işareti kullandığınız için belge isminde bu işareti kabul etmez. Oradaki değeri 1. Sınıf / B Şubesi yerine 1. Sınıf - B Şubesi olarak yazın sonuç alırsınız.

vurkan · 25 Temmuz 2018

Sayın Aksm eklediğim desyada SINIF sayfasında F10 hücresin in benim için bir önemi yok. Asıl önemli olan BRANŞ sayfasındaki F10 hücresi. Diğer dosyalarda kurgu SINIF sayfasındayken bu dosyada sınıf sayfası başka amaç için kullanılıyor. Yani diğer dosyalardaki SINIF adlı sayfanın yerine BRANŞ adlı sayfayı koydum. İşlem ona göre olmalı.
Koddaki SINIF yazısını BRANŞ olarak değiştirince;

ActiveWorkbook.Sheets(s).PasteSpecial
satırında hata verdi saygılar.

askm · 25 Temmuz 2018

Ben kodlarınızı sıfırdan yazmadım. Sadece belirttiğiniz soruya göre kodlara ilave yaptım.
Set s1 = Sheets("SINIF")
kısmını BRANŞ olarak değiştirip deneyin. Buradaki F10 değeri dolu olarak örnek dosyayı o yüzden istemiştim.

vurkan · 25 Temmuz 2018

Set s1 = Sheets("BRANŞ")

yaptım ve
ActiveWorkbook.Sheets(s).PasteSpecial
satırında hata verdi saygılar.

Soru Aynı Klasördeki başka bir dosyadan bir alanı seçip yapıştırma

vurkan

vurkan

PLİNT

vurkan

vurkan

vurkan

vurkan

PLİNT

vurkan

vurkan

askm

Destek Ekibi

vurkan

askm

Destek Ekibi

vurkan

askm

Destek Ekibi

Ekli dosyalar

vurkan

askm

Destek Ekibi

vurkan

askm

Destek Ekibi

vurkan