• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Giden Yazı Şablonu

Hakan ERDOST

Hakan ERDOST

Destek Ekibi
Destek Ekibi
Katılım
12 Eylül 2004
Mesajlar
885
Excel Vers. ve Dili
Excel 2019 Türkçe (Ev)
Excel 2013 Türkçe (Okul)
Herkese merhaba ekli dosyada okulda yazdığımız giden yazı şablonu var.Bu şablon ile makro ekleyerek aşağıdakileri yapabilirmiyiz?
1-Yazıyı yazdıktan sonra Arşive aktar butonu ile (eklenecek) önce belgelerim altında giden evrak diye bir klasör oluşturacak (yok ise sadece bir kez) bu klasöürün adını E7 hücresinden alacak,
2-Klasörün altına belgeyi konudan (C8) isim alarak adlandırıp kayıt yapacak,
bir makro yazılabilir mi?
 

Ekli dosyalar

Selamlar,

Aşağıdaki kodu denermisiniz. Koddaki kırmızı renkli bölümleri kendi sisteminize göre uyarlamayı unutmayın.

Kod: 
Option Explicit
 
Sub ARŞİVE_AKTAR()
    Dim FSO As Object, DOSYA_YOLU As String, DOSYA_ADI As String
    Dim KLASÖR As String, DOSYA_ARA As String, EK As Byte
    
    If Range("E7") = Empty Then
        Range("E7").Select
        MsgBox "E7 hücresi boş. Lütfen veri giriniz !", vbExclamation, "Dikkat !"
        Exit Sub
    End If
    
    If Range("C8") = Empty Then
        Range("C8").Select
        MsgBox "C8 hücresi boş. Lütfen veri giriniz !", vbExclamation, "Dikkat !"
        Exit Sub
    End If
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    EK = 1
    DOSYA_YOLU = [COLOR=red]"C:\Users\Admin\Documents\"[/COLOR] & Range("E7")
    DOSYA_ADI = Range("C8") & "_" & Format(EK, "00")
    KLASÖR = DOSYA_YOLU & "\*.xls"
    
    If Not FSO.FolderExists(DOSYA_YOLU) Then
        FSO.CreateFolder (DOSYA_YOLU)
    End If
        
    DOSYA_ARA = Dir(KLASÖR)
    
    While DOSYA_ARA <> ""
        If Replace(DOSYA_ARA, ".xls", "") = DOSYA_ADI Then
            EK = EK + 1
            DOSYA_ADI = Range("C8") & "_" & Format(EK, "00")
        End If
        DOSYA_ARA = Dir
    Wend
        
    Application.ScreenUpdating = False
        [COLOR=red]Sheets("Sayfa1").Copy[/COLOR]
        ActiveWorkbook.SaveAs Filename:=DOSYA_YOLU & "\" & DOSYA_ADI & ".xls", FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        ActiveWindow.Close
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Teşekkürler Korhan AYHAN.Dosyayı tamamladım ekledim.Bu basit bir çalışma ama okullarda verimli olarak kullanılabilecek bir uygulama olur sanırım, bu anlamda Uygulamalar başlığına taşınabilir.Ancak, kodlara bir bakarsanız tekrar. Dosya adı tamam.Çalışma kitabı adını aldığında klasörün altını konrol edip aynı adla çalışma kitabı var ise yeniden adlandırma yapılabilecek bir kod ile sanırım tamamlanmış olur.Teşekkürler kolay gelsin.
 

Ekli dosyalar

Selamlar,

Klasörü altında aynı isimli dosya varsa nasıl bir işlem yapmasını istiyorsunuz?

Örnek;

120\İkinci Deneme isimli dosya var. Tekrar butona tıklandığında nasıl bir işlem yapılacak?
 
Sayın hexadesimal
İlköğretim okulu Sayı olarak Sadece Desimal ve Kayıt No kullanabilir. Yani 230/12 gibi. Dosyanızda ki "B.08.4.MEM.4.35.015.01." kodunu il ve ilçe Milli Eğitim Müdürlükleri kllanabilir.
Bölüm:
Sayı :
Konu :
şeklinde olmalı. Dosyanızda Bölüm eklenmemiş. Birde deneme ilköğretim okulu Müdürlüğü yazısının altına MEBBİS Okul kodu yazılma zorunluluğu bulunmaktadır.
Bu şekilde düzenlenebilir mi?
 
Korhan Ayhan' Alıntı:
Selamlar,

Klasörü altında aynı isimli dosya varsa nasıl bir işlem yapmasını istiyorsunuz?

Örnek;

120\İkinci Deneme isimli dosya var. Tekrar butona tıklandığında nasıl bir işlem yapılacak?
Genişletmek için tıkla ...

Arşive aktar butonuna tıklandığında ;Aynı isimli çalışma kitabı var ise bir mesaj kutusu ile uyarıp farklı kaydet menüsünü çağırmak yada çalışma kitabına rakam ekleyerek kayıt edilebilir.Örneğin 120 nin altında "ikinci deneme"adlı bir çalışma kitabı olduğundan aynı isimli bir çalışma kitabı tekrar aktarılmaya çaılşıldığında uyarıp bununu "ikinci deneme_1"... şeklinde kayıt edebilir.
 
Yesilyurtlu' Alıntı:
Sayın hexadesimal
İlköğretim okulu Sayı olarak Sadece Desimal ve Kayıt No kullanabilir. Yani 230/12 gibi. Dosyanızda ki "B.08.4.MEM.4.35.015.01." kodunu il ve ilçe Milli Eğitim Müdürlükleri kllanabilir.
Bölüm:
Sayı :
Konu :
şeklinde olmalı. Dosyanızda Bölüm eklenmemiş. Birde deneme ilköğretim okulu Müdürlüğü yazısının altına MEBBİS Okul kodu yazılma zorunluluğu bulunmaktadır.
Bu şekilde düzenlenebilir mi?
Genişletmek için tıkla ...

Kodalama tamamlandığında belirttiğiniz değişiklikler yapılabilir.Ayrıca desimal sistemi ile ilgili olarak ben bir okul müdürüyüm.resmi yazışma kuralları ile igili yönetmeliğe bakmanızı tavsiye ederim.(Litfen yanlış anlamayın.Yanlış biliyor da olabilirim)
 
Sayın hexadesimal, Sayın Müdürüm.
Ben ilçe Milli eğitimde görev yapıyorum."B.08.4.MEM.4.35.015.01"
Yönetmelik bu kodu genel olarak almıştır. il ve ilçeler kullanır. okul sadece desimal kodunu ve kayıt numarasını kullanır. Örneğin sizden bize böyle bir yazı gelse ben direk il ya da ilçeyi ararım okul aklıma gelmez. Ama sizin oralarda kullanılıyorsa doğrudur müdürüm. Benim ki sadece bir öneri idi.
 
Polemik olsun diye değil.Bilgimizi paylaşmak adına.Varsa yenlış düzeltiriz.
Desimal kod sistemi daha detaylı olarak eklenmiş hali ekte.Bölümde neyi kast ettiğinizi anlayamadım.
 

Ekli dosyalar

Son düzenleme:
Selamlar,

#2 nolu mesajımdaki kodu güncelledim. İncelermisiniz.
 
Korhan Ayhan' Alıntı:
Selamlar,

Aşağıdaki kodu denermisiniz. Koddaki kırmızı renkli bölümleri kendi sisteminize göre uyarlamayı unutmayın.

Kod: 
Option Explicit
 
Sub ARŞİVE_AKTAR()
    Dim FSO As Object, DOSYA_YOLU As String, DOSYA_ADI As String
    Dim KLASÖR As String, DOSYA_ARA As String, EK As Byte
    
    If Range("E7") = Empty Then
        Range("E7").Select
        MsgBox "E7 hücresi boş. Lütfen veri giriniz !", vbExclamation, "Dikkat !"
        Exit Sub
    End If
    
    If Range("C8") = Empty Then
        Range("C8").Select
        MsgBox "C8 hücresi boş. Lütfen veri giriniz !", vbExclamation, "Dikkat !"
        Exit Sub
    End If
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    EK = 1
    DOSYA_YOLU = [COLOR=red]"C:\Users\Admin\Documents\"[/COLOR] & Range("E7")
    DOSYA_ADI = Range("C8") & "_" & Format(EK, "00")
    KLASÖR = DOSYA_YOLU & "\*.xls"
    
    If Not FSO.FolderExists(DOSYA_YOLU) Then
        FSO.CreateFolder (DOSYA_YOLU)
    End If
        
    DOSYA_ARA = Dir(KLASÖR)
    
    While DOSYA_ARA <> ""
        If Replace(DOSYA_ARA, ".xls", "") = DOSYA_ADI Then
            EK = EK + 1
            DOSYA_ADI = Range("C8") & "_" & Format(EK, "00")
        End If
        DOSYA_ARA = Dir
    Wend
        
    Application.ScreenUpdating = False
        [COLOR=red]Sheets("Sayfa1").Copy[/COLOR]
        ActiveWorkbook.SaveAs Filename:=DOSYA_YOLU & "\" & DOSYA_ADI & ".xls", FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
        ActiveWindow.Close
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...

Bu kodlarda yaptığım değişiklik ile bmp veya jpg olarak sayfayı kaydediyorum ancak oluşan dosyayı açamıyorum.
Sebep ne olabilir.
 
Korhan hocam arşive aktar dediğimizde "PDF" olarak kayıt yaptırmak istesek kod nasıl olur.
Selamlar.
(offıce2207)
 
Sayın yesilyurtlu ili ilçesi okulu falan kalmadı. 01/01/2013 tarihinden beri "İdari Birim Kimlik Kodları" kullanılmaktadır. Çalıştığınız il yada ilçe idari birim kimlik kodunu öğrenmek istiyorsanız, DTVT (Devlet Teşkilatı Veri Tabanı)na girer, arama yerine ... ilçe milli eğitim müdürlüğü yazarsınız. listeyi görürsünüz. iyi çalışmalar.
Sayın hexadecimal, yazışma şablonunu word ile yapmanız daha pratik olur. görünmeyen tablolar kullanınız. standart dosya planı için excel ile bir arama programı yapmanız yeterli olacaktır.
Kolay gelsin.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst