Makro ile otomatik yazdırma

SeviLmeyen · 6 Haziran 2020

Selamlar iyi çalışmalar. Yardım istediğim nokta şudur. A1 den AJ6800 e kadar 36 başlığı olan bir listem mevcut. Bir buton oluşturdum ve Rapor alıyorum. Ama aldığım raporda sıkıntı oluşuyor.
Raporu alırken sütun genişlikleri kaynaktaki ile aynı olmuyor yanlış yorumlamadıysam Başlıktaki Metin ya da yazılan en uzun metine göre genişliği kendisi oluşturuyor.

Mevcut Makro içeriği;

Mevcut kaynak;

Rapor sonu oluşan durum;

Korhan Ayhan · 6 Haziran 2020

Makro sütun genişlikleri ilk önce 50 olarak ayarlanıyor. Sonrasında ise otomatik genişleme komutu çalıştırılıyor.

SeviLmeyen · 6 Haziran 2020

Korhan Ayhan' Alıntı:
Makro sütun genişlikleri ilk önce 50 olarak ayarlanıyor. Sonrasında ise otomatik genişleme komutu çalıştırılıyor.

Korhan Bey ne eklemeliyim ki otomatik çalışmasın kaynak genişliği ile aynı olsun

SeviLmeyen · 6 Haziran 2020

Korhan Ayhan · 6 Haziran 2020

Kendinize uyarlayınız.

C++:

Option Explicit

Sub Rapor()
    Dim K1 As Workbook, S1 As Worksheet, Alan As Range
    
    Set K1 = ThisWorkbook
    Set S1 = K1.ActiveSheet
    
    S1.Range("A5:AJ6867").Copy
    
    Workbooks.Add
    
    With ActiveSheet.Range("A1")
        .PasteSpecial xlPasteAll
        .PasteSpecial xlPasteValues
        .Select
    End With
    
    Application.CutCopyMode = False

    Application.ScreenUpdating = False

    For Each Alan In S1.Range("A1:AJ1")
        Cells(1, Alan.Column).ColumnWidth = Alan.ColumnWidth
    Next

    Application.ScreenUpdating = True
End Sub

SeviLmeyen · 6 Haziran 2020

Korhan Ayhan' Alıntı:

Kendinize uyarlayınız.

C++:

Option Explicit

Sub Rapor()
    Dim K1 As Workbook, S1 As Worksheet, Alan As Range
  
    Set K1 = ThisWorkbook
    Set S1 = K1.ActiveSheet
  
    S1.Range("A5:AJ6867").Copy
  
    Workbooks.Add
  
    With ActiveSheet.Range("A1")
        .PasteSpecial xlPasteAll
        .PasteSpecial xlPasteValues
        .Select
    End With
  
    Application.CutCopyMode = False

    Range("A:AJ").ColumnWidth = S1.Range("A:AJ").ColumnWidth
End Sub

Korhan Bey en kısa zamanda deneyeceğim ve geri dönüş sağlayacağım teşekkür ediyorum ilginiz için.

SeviLmeyen · 8 Haziran 2020

Korhan Ayhan' Alıntı:

Kendinize uyarlayınız.

C++:

Option Explicit

Sub Rapor()
    Dim K1 As Workbook, S1 As Worksheet, Alan As Range
  
    Set K1 = ThisWorkbook
    Set S1 = K1.ActiveSheet
  
    S1.Range("A5:AJ6867").Copy
  
    Workbooks.Add
  
    With ActiveSheet.Range("A1")
        .PasteSpecial xlPasteAll
        .PasteSpecial xlPasteValues
        .Select
    End With
  
    Application.CutCopyMode = False

    Range("A:AJ").ColumnWidth = S1.Range("A:AJ").ColumnWidth
End Sub

Korhan Bey selamlar. Kodu yazdım denedim ama bu seferde bütün sütun genişlikleri 8,43 olarak açılıyor.
Mesela benim G-H-I Sütünları 20 B-C sütünları 8

Korhan Ayhan · 8 Haziran 2020

Sorunu anladım. Sütun genişlikleri farklı olduğu için önerdiğim kodda sorun oluşuyor. Üstteki mesajımda ki kodu revize ettim. Tekrar deneyiniz.

SeviLmeyen · 8 Haziran 2020

Korhan Ayhan' Alıntı:
Sorunu anladım. Sütun genişlikleri farklı olduğu için önerdiğim kodda sorun oluşuyor. Üstteki mesajımda ki kodu revize ettim. Tekrar deneyiniz.

Korhan Bey çok teşekkür ediyorum oldu. Ellerinize sağlık.

SeviLmeyen · 8 Haziran 2020

SeviLmeyen' Alıntı:
Korhan Bey çok teşekkür ediyorum oldu. Ellerinize sağlık.

Aynı konuya istinaden benim aslında A1,2,3,4 satırlarında butonlarım genel başlıklarım tonaj toplamları falan var. Ben Rapor koduna A1,2,3,4 ten çektirmeye çalıştığımda bozuluyor. S1.Range (A5 yerine A1) yazdığımda böyle oluyor.
Ben raporda butonlar hariç diğer başlıkları tonaj toplamlarını gösteren bir kod revize edilebilir mi acaba

Rapor çekmeye çalıştığımda oluşan durum da aşağıdaki gibi;

Korhan Ayhan · 8 Haziran 2020

Örnek dosyanızı paylaşırsanız daha hızlı sonuca gidebiliriz. Ulaşmak istediğiniz sonuca ilişkinde örnek ekleyiniz.

SeviLmeyen · 8 Haziran 2020

Korhan Ayhan' Alıntı:
Örnek dosyanızı paylaşırsanız daha hızlı sonuca gidebiliriz. Ulaşmak istediğiniz sonuca ilişkinde örnek ekleyiniz.

Akşam eve geçince atayım şirketten böyle bir imkanım yok maalesef. Teşekkür ediyorum.

SeviLmeyen · 8 Haziran 2020

SeviLmeyen' Alıntı:
Akşam eve geçince atayım şirketten böyle bir imkanım yok maalesef. Teşekkür ediyorum.

Korhan Bey Örnek Tablomu ekte paylaşıyorum.

1- Rapor Butonuna basıldığı zaman A1 den AJ6865 'e kadar olan Tüm başlıkları Farklı bir Excel sayfasına aktarım yapsın ve bunu yaparken Sayfa Sonu ve Rapor butonu gözükmesin. 5. satırdaki başlıklar kaynak başlığı genişliği ile aynı olsun.
2- Oluşturulan farklı sayfadaki excel verileri bir mail adresine gönderilmek üzere Outlook mail sayfasına yerleşsin ben manuel gönderilecek kişileri eklerim. Ya da bir boşluk bırakılırsa sonra ben mail adresini girebilirim kodun içine. Yapılabilir ise CC kısmı ve Konu başlığı ve yazılacak metini yazabileceğimiz bir alan koda eklenebilirse mutlu olurum. Not: Eğer veri silinmesi vs olaylar yaşanıyorsa bu durumda hiç gerek yok.
3- Ekipman isimleri K ve yaptıkları tonajlar R sütununda işlenecek Örnekte gördüğünüz gibi Ekipman-Tonaj ve % Pivotu yapmaya çalıştım elimden geldiği kadarı ile. Bu Pivot daha da iyileştirilebilir mi? Ya da Pivot kullanmadan başka bir şekilde o yaptığıma benzer bir şey oluşturulabilir mi?
4- En karmaşık kısım bu Beklemeler kısımları 4 farklı şekilde ama aynı amaçta oluşturulmuş. Ben bu beklemelerinde bir pivotunu oluşturmak istiyorum ya da ona benzer bişey ama durum şöyle. Bekleme-1,2,3,4 Açıklama-1,2,3,4 ve Bekleme Dakikaları 1,2,3,4 şeklinde olunca Pivot oluşturmaya çalıştığımda birbirlerinin içlerine giriyorlar haliyle ve istediğim olmuyor. İstediğim yapılabilir ise şu;
Sayfa-1 diye bu istek şekli ile ilgili bir şablon oluşturdum Tüm Bekleme, Açıklama ve Dakikaları kapsayacak şekilde oluşturulabilir mi?

Umarım uğraşılacak bir şeydir ve benim için çok güzel olur.
Saygılarımla,

İndir Defter Çalışma

Dosyayı indir Defter Çalışma

dosya.co

SeviLmeyen · 9 Haziran 2020

Korhan Ayhan · 9 Haziran 2020

Mail gönderme ile ilgili yapıyı paylaşıyorum. Gerisini kendinizin halletmesi gerekiyor.

Dosyanıza boş bir sayfa ekleyin. (Adı Mail_Settings olsun)

Bu sayfada A ve B sütunlarını görseldeki gibi ayarlayın. B sütununa mail adreslerini ve konusunu yazıp kullanabilirsiniz.

Sonrasında aşağıdaki kodu mail göndermek için kullanabilirsiniz.

C++:

Option Explicit

Sub Vardiya_Raporunu_Mail_Gonder()
    Dim K1 As Workbook, S1 As Worksheet, S2 As Worksheet, K2 As Workbook, S3 As Worksheet
    Dim Uygulama As Object, Yeni_Mail As Object, Dosya_Adi As String, Onay As Byte, Mesaj As String
    
    Onay = MsgBox("Kayıt edip mail göndermek istiyor musunuz?", vbExclamation + vbYesNo, "Uyarı")
    If Onay = vbNo Then
        MsgBox "İşleminiz iptal edilmiştir.", vbInformation
        Exit Sub
    End If
        
    Set K1 = ThisWorkbook
    Set S1 = K1.Sheets("VardiyaRapor")
    Set S2 = K1.Sheets("Mail_Settings")
    
    On Error Resume Next
    Set Uygulama = GetObject(, "Outlook.Application")
    On Error GoTo 0
    
    If Uygulama Is Nothing Then Call Shell("Outlook.exe", vbHide)
    
    Set Uygulama = CreateObject("Outlook.Application")
    Set Yeni_Mail = Uygulama.CreateItem(0)
    
    Dosya_Adi = K1.Path & Application.PathSeparator & Format(Date, "dd mmmm") & " Vardiya Raporu.xlsx"
    
    S1.Copy
    
    Set K2 = ActiveWorkbook
    Set S3 = K2.Sheets(1)
    
    Application.DisplayAlerts = False
    
    With S3
        .Name = "Vardiya Raporu"
        .Unprotect
        .Range("A6866:A1048576").EntireRow.Delete
        .Range("AK:AL").EntireColumn.Delete
        .DrawingObjects.Delete
        .Protect
    End With

    K2.Close True, Dosya_Adi
    
    Application.DisplayAlerts = True


    Mesaj = "<Body Style=Font-Size:10pt;Font-Family:Arial>Merhaba,<br><br>" & _
              Format(Date, "dd mmmm") & " tarihli vardiya raporu ekte bilgilerinize sunulmuştur.<br>" & _
              "<br><br>Saygılarımla.</Body>"
    
    With Yeni_Mail
        .Display
        .To = S2.Cells(1, 2).Value
        .CC = S2.Cells(2, 2).Value
        .BCC = S2.Cells(3, 2).Value
        .Subject = S2.Cells(4, 2).Value
        .HTMLBody = Mesaj & "<br>" & .HTMLBody
        .Attachments.Add Dosya_Adi
        .BodyFormat = 2
        .Save
        '.Send
    End With
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Set K1 = Nothing
    Set K2 = Nothing
    Set Yeni_Mail = Nothing
    Set Uygulama = Nothing
End Sub

SeviLmeyen · 9 Haziran 2020

Korhan Ayhan' Alıntı:

Mail gönderme ile ilgili yapıyı paylaşıyorum. Gerisini kendinizin halletmesi gerekiyor.

Dosyanıza boş bir sayfa ekleyin. (Adı Mail_Settings olsun)

Bu sayfada A ve B sütunlarını görseldeki gibi ayarlayın. B sütununa mail adreslerini ve konusunu yazıp kullanabilirsiniz.

Ekli dosyayı görüntüle 218947

Sonrasında aşağıdaki kodu mail göndermek için kullanabilirsiniz.

C++:

Option Explicit

Sub Vardiya_Raporunu_Mail_Gonder()
    Dim K1 As Workbook, S1 As Worksheet, S2 As Worksheet, K2 As Workbook, S3 As Worksheet
    Dim Uygulama As Object, Yeni_Mail As Object, Dosya_Adi As String, Onay As Byte, Mesaj As String
   
    Onay = MsgBox("Kayıt edip mail göndermek istiyor musunuz?", vbExclamation + vbYesNo, "Uyarı")
    If Onay = vbNo Then
        MsgBox "İşleminiz iptal edilmiştir.", vbInformation
        Exit Sub
    End If
       
    Set K1 = ThisWorkbook
    Set S1 = K1.Sheets("VardiyaRapor")
    Set S2 = K1.Sheets("Mail_Settings")
   
    On Error Resume Next
    Set Uygulama = GetObject(, "Outlook.Application")
    On Error GoTo 0
   
    If Uygulama Is Nothing Then Call Shell("Outlook.exe", vbHide)
   
    Set Uygulama = CreateObject("Outlook.Application")
    Set Yeni_Mail = Uygulama.CreateItem(0)
   
    Dosya_Adi = K1.Path & Application.PathSeparator & Format(Date, "dd mmmm") & " Vardiya Raporu.xlsx"
   
    S1.Copy
   
    Set K2 = ActiveWorkbook
    Set S3 = K2.Sheets(1)
   
    Application.DisplayAlerts = False
   
    With S3
        .Name = "Vardiya Raporu"
        .Unprotect
        .Range("A6866:A1048576").EntireRow.Delete
        .Range("AK:AL").EntireColumn.Delete
        .DrawingObjects.Delete
        .Protect
    End With

    K2.Close True, Dosya_Adi
   
    Application.DisplayAlerts = True


    Mesaj = "<Body Style=Font-Size:10pt;Font-Family:Arial>Merhaba,<br><br>" & _
              Format(Date, "dd mmmm") & " tarihli vardiya raporu ekte bilgilerinize sunulmuştur.<br>" & _
              "<br><br>Saygılarımla.</Body>"
   
    With Yeni_Mail
        .Display
        .To = S2.Cells(1, 2).Value
        .CC = S2.Cells(2, 2).Value
        .BCC = S2.Cells(3, 2).Value
        .Subject = S2.Cells(4, 2).Value
        .HTMLBody = Mesaj & "<br>" & .HTMLBody
        .Attachments.Add Dosya_Adi
        .BodyFormat = 2
        .Save
        '.Send
    End With
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
   
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Set K1 = Nothing
    Set K2 = Nothing
    Set Yeni_Mail = Nothing
    Set Uygulama = Nothing
End Sub

Teşekkür ederim Korhan Bey deneyeceğim. Peki diğer durumlar ile ilgili bir görüşünüz var mi?

SeviLmeyen · 10 Haziran 2020

SeviLmeyen' Alıntı:
Teşekkür ederim Korhan Bey deneyeceğim. Peki diğer durumlar ile ilgili bir görüşünüz var mi?

Korhan Bey Mail Gönderimi hakkındaki yapı ve kod başarılı bir şekilde çalışıyor. Tarih 10 Haziran olarak görünüyor kod içinde date kısmına ne eklersek 10 Haziran 2020 olarak görünür? Çok Teşekkür ediyorum ellerinize sağlık. Peki diğer durumlar ile ilgili bir görüşünüz var mi?

SeviLmeyen · 10 Haziran 2020

SeviLmeyen' Alıntı:
Korhan Bey Mail Gönderimi hakkındaki yapı ve kod başarılı bir şekilde çalışıyor. Tarih 10 Haziran olarak görünüyor kod içinde date kısmına ne eklersek 10 Haziran 2020 olarak görünür? Çok Teşekkür ediyorum ellerinize sağlık. Peki diğer durumlar ile ilgili bir görüşünüz var mi?

"dd mmmm" olan yere "dd mmmm yyyy" yazdım. Tarihide attı sanırım oldu.

Korhan Ayhan · 10 Haziran 2020

Dosya adındaki tarih için aşağıdaki satırı bulup değiştirin.

Dosya_Adi = K1.Path & Application.PathSeparator & Format(Date, "dd mmmm yyyy") & " Vardiya Raporu.xlsx"

Mail penceresindeki mesaj için aşağıdaki satırı bulup değiştirin.

Mesaj = "<Body Style=Font-Size:10pt;Font-Family:Arial>Merhaba, " & _
Format(Date, "dd mmmm yyyy") & " tarihli vardiya raporu ekte bilgilerinize sunulmuştur. " & _
" Saygılarımla.</Body>"

Korhan Ayhan · 10 Haziran 2020

Diğer sorularınız için ayrı başlık açarak çözüm aramalısınız.

Makro ile otomatik yazdırma

SeviLmeyen

Korhan Ayhan

Administrator

SeviLmeyen

SeviLmeyen

Korhan Ayhan

Administrator

SeviLmeyen

SeviLmeyen

Korhan Ayhan

Administrator

SeviLmeyen

SeviLmeyen

Korhan Ayhan

Administrator

SeviLmeyen

SeviLmeyen

İndir Defter Çalışma

SeviLmeyen

Korhan Ayhan

Administrator

SeviLmeyen

SeviLmeyen

SeviLmeyen

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator