• DİKKAT

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

iki makroyu birleştirmek

  • Konbuyu başlatan Konbuyu başlatan karsel1
  • Başlangıç tarihi Başlangıç tarihi
Katılım
1 Mart 2010
Mesajlar
11
Excel Vers. ve Dili
2007
Merhabalar..

Bir ilköğretim kurumunda idareci olarak çalışıyorum.
Aşamalı Davamsızlık Yönetimi gereği velilerle görüşme yapmam gerekiyor ve görüşme fişini yazdırırken fazla zaman harcamamak için örnekte sunulan basit bir çizelge hazırladım.

Görüşme fişinin yazdırılması ve görüşme fişinin ayrıntılarını kaydetmem açısından Bu forumdaki üstadların hazıladığı iki makroyu buldum fakat birleştiremedim.


Yapmak istediğim yazdır dediğimde devam veya davr sayflarından seçtiklerimin yazdırılması ve hangi sayfayı yazdırıyorsam onun ayrıntılarını diğer sayfaya kaydetmesi.

Biraz uzun oldu zahmet edip okuduysanız ve yardım edebilirseniz çok sevinirim.

Saygılarımla...

Birden fazla sayfayı yazdırma
Kod:
    Private Sub CommandButton1_Click()
    If CheckBox1.Value = False And CheckBox2.Value = False And CheckBox3.Value = False And CheckBox4.Value = False And CheckBox5.Value = False Then
         MsgBox "Seçili sayfanız yok"
    Else
         If CheckBox1.Value = True Then Sheets("Sayfa1").PrintOut Copies:=1, Collate:=True
         If CheckBox2.Value = True Then Sheets("Sayfa2").PrintOut Copies:=1, Collate:=True
         If CheckBox3.Value = True Then Sheets("Sayfa3").PrintOut Copies:=1, Collate:=True
         If CheckBox4.Value = True Then Sheets("Sayfa4").PrintOut Copies:=1, Collate:=True
         If CheckBox5.Value = True Then Sheets("Sayfa5").PrintOut Copies:=1, Collate:=True
    End If

    End Sub

    Private Sub CheckBox1_Change()
    If CheckBox1.Value = True Then CheckBox1.Caption = "Sayfa1 Seçildi"
    If CheckBox1.Value = False Then CheckBox1.Caption = "Sayfa1 Seçilmedi"
    End Sub

    Private Sub CheckBox2_Change()
    If CheckBox2.Value = True Then CheckBox2.Caption = "Sayfa2 Seçildi"
    If CheckBox2.Value = False Then CheckBox2.Caption = "Sayfa2 Seçilmedi"
    End Sub

    Private Sub CheckBox3_Change()
    If CheckBox3.Value = True Then CheckBox3.Caption = "Sayfa3 Seçildi"
    If CheckBox3.Value = False Then CheckBox3.Caption = "Sayfa3 Seçilmedi"
    End Sub

    Private Sub CheckBox4_Change()
    If CheckBox4.Value = True Then CheckBox4.Caption = "Sayfa4 Seçildi"
    If CheckBox4.Value = False Then CheckBox4.Caption = "Sayfa4 Seçilmedi"
    End Sub

    Private Sub CheckBox5_Change()
    If CheckBox5.Value = True Then CheckBox5.Caption = "Sayfa5 Seçildi"
    If CheckBox5.Value = False Then CheckBox5.Caption = "Sayfa5 Seçilmedi"
    End Sub

    Private Sub UserForm_Initialize()
    CheckBox1.Caption = "Sayfa1 Seçilmemiş"
    CheckBox2.Caption = "Sayfa2 Seçilmemiş"
    CheckBox3.Caption = "Sayfa3 Seçilmemiş"
    CheckBox4.Caption = "Sayfa4 Seçilmemiş"
    CheckBox5.Caption = "Sayfa5 Seçilmemiş"
    End Sub
yazdırlan sayfayı kaydetme
Kod:
Option Explicit
 
Sub YAZDIR_YEDEKLE()
    Dim SAYFA As String, SATIR As Long, YAZDIR As Boolean
 
    Sheets("MAKBUZ").Select
 
    If Range("I7") <> "" Then
        SAYFA = Range("I7")
    Else
        MsgBox "Lütfen firma adı giriniz !", vbCritical
        Range("I7").Select
        Exit Sub
    End If
 
    YAZDIR = Application.Dialogs(xlDialogPrint).Show
 
    If YAZDIR = False Then
        MsgBox "İşleminiz iptal edilmiştir.", vbExclamation
        Exit Sub
    End If
 
    If SAYFA = "TÜRKSAT" Or SAYFA = "SMİLE" Or SAYFA = "DİGİTÜRK" Or _
    SAYFA = "VODAFONE" Or SAYFA = "AVEA" Or SAYFA = "TÜRKCELL" Then GoTo Devam
 
    If SAYFA = "TEDAŞ" Then
 
        With Sheets(SAYFA)
             SATIR = .Range("A65536").End(3).Row + 1
            .Cells(SATIR, "A") = Range("F7")
            .Cells(SATIR, "B") = Range("I9")
            .Cells(SATIR, "C") = Range("F9")
            .Cells(SATIR, "D") = Range("O12") - 1
            .Cells(SATIR, "E") = Format(Range("O9"), "dd.mm.yyyy")
            .Cells(SATIR, "F") = Format(Range("O7"), "dd.mm.yyyy")
            .Cells(SATIR, "G") = Format(Range("I10"), "hh:mm:ss")
        End With
 
    ElseIf SAYFA = "KREDİ KARTI" Then
 
        With Sheets(SAYFA)
             SATIR = .Range("A65536").End(3).Row + 1
            .Cells(SATIR, "A") = Range("F7")
            .Cells(SATIR, "B") = Range("I9")
            .Cells(SATIR, "C") = Range("F9")
            .Cells(SATIR, "D") = Range("O12") - 1
            .Cells(SATIR, "E") = Format(Range("O9"), "dd.mm.yyyy")
            .Cells(SATIR, "F") = Format(Range("O7"), "dd.mm.yyyy")
            .Cells(SATIR, "G") = Format(Range("I10"), "hh:mm:ss")
        End With
 
    Else
 
        With Sheets(SAYFA)
             SATIR = .Range("A65536").End(3).Row + 1
            .Cells(SATIR, "A") = Range("F7")
            .Cells(SATIR, "B") = Range("I7")
            .Cells(SATIR, "C") = Range("F9")
            .Cells(SATIR, "D") = Range("O12") - 1
            .Cells(SATIR, "E") = Format(Range("O9"), "dd.mm.yyyy")
            .Cells(SATIR, "F") = Format(Range("O7"), "dd.mm.yyyy")
            .Cells(SATIR, "G") = Format(Range("I10"), "hh:mm:ss")
        End With
    End If
 
Devam:
    With Sheets("TÜMÜ")
         SATIR = .Range("A65536").End(3).Row + 1
        .Cells(SATIR, "A") = Range("F7")
        .Cells(SATIR, "B") = Range("I7")
        .Cells(SATIR, "C") = Range("F9")
        .Cells(SATIR, "D") = Range("O12") - 1
        .Cells(SATIR, "E") = Format(Range("O9"), "dd.mm.yyyy")
        .Cells(SATIR, "F") = Format(Range("O7"), "dd.mm.yyyy")
        .Cells(SATIR, "G") = Range("I9")
    End With
End Sub
 

Ekli dosyalar

Saygıdeğer Arkadaşlar,
Acaba açıklamalarım mı eksik,yoksa karışıkmı çünkü 67 görüntüleme var ama cevap hiç yok.
Eğer anlaşılmayan bir yer varsa daha detaylı açıklama yapabilirim.
saygılarımla
 
Merhaba,

Ekteki örnek dosyayı incelermisiniz.
 

Ekli dosyalar

Bu dosyanın nasıl kullanılacağı hakkında bilgi verir misin?
 
Bu dosyanın nasıl kullanılacağı hakkında bilgi verir misin?

Aktif olarak ana sayfa kullanılacak
Yani öğrencinin numarasını girdiğimde öğrencinin diğer bilgileri formlara dolacak
Devamsızlk nedeni ile veli ile görüşmüşssem devam sayfasını yazdırıp veliye imzalatarak dosyaya kaldıracam. Yok eğer davranış nedeniyle görüşüldüyse o yazdırılacak.

Ancak öğrenci için öceki görüşme terihlerini arşivlediğim tutanakları karıştırmadan bulabilmem lazım. "yani veliye şu tarihtede sizinle şu konuda görüşmüşüz diyebilmek için"

Excelde makro konusunda acemi olduğum için daha kullanışlı birşey aklıma gelmiyor.
 
Merhaba,

Ekteki örnek dosyayı incelermisiniz.

Korhan Bey. Teşekkür ederim çok güzel olmuş. Elinize sağlık.

Ancak tam olarak istediğim ;
Ana sayfadaki butona tıkladığımda Userformda işaretlediğim sayfaların yazdırılması(Bu kısım tamam) ve işarete bağlı olarak kayıt işleminin bundan sonra yapması..
Saygılar...
 

Ekli dosyalar

Geri
Üst