cari mutabakat mektubu

assenucler

Altın Üye
Katılım
19 Ağustos 2004
Mesajlar
3,552
Excel Vers. ve Dili
Ofis 365 TR 64 Windows 11 Home Single Language x64 TR
Altın Üyelik Bitiş Tarihi
29-05-2025
Sayın baydoğannn,


Merhaba, rica etsem dosyanın son şeklini yükleyebilir misiniz?

Sayın Hüseyin Çoban üstadıma da katkılarından ve emeklerinden dolayı teşekkürler.

Sevgi ve saygılar.
 
Katılım
25 Ağustos 2010
Mesajlar
46
Excel Vers. ve Dili
Ofice 2013
Ttürkçe
Altın Üyelik Bitiş Tarihi
21-09-2024
Mail İmza

. . .

Kodlar çalışıyor. Bir kaç revize yaptım.
Dosyanız ektedir ve çalışma adımları videosu aşağıdadır.

Dikkat etmeniz gerek kısımlar;
  • Mizan sayfası ile mail gönder sayfasındaki firma isimleri aynı olmalı.
  • mail gönder sayfasında C sütununda mail göndermek istediğiniz firmaları seçip, kodu çalıştırın.

Ekran Görüntüsü (GİF)



. . .

Günaydın Hüseyin bey,

ilk olarak elinize sağlık süper bir çalışma olmuş. otomatik mail gönderiminde outlook imzası çıkmıyor. excel içerisine "imza" adında bir sayfanın A1 hücresine girilen metni otomatik tüm maillerin içerisine eklenebilme ihtimali var mı? yardımcı olabilir misiniz?
teşekkürler
 

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,892
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
Günaydın Hüseyin bey,
ilk olarak elinize sağlık süper bir çalışma olmuş. otomatik mail gönderiminde outlook imzası çıkmıyor. excel içerisine "imza" adında bir sayfanın A1 hücresine girilen metni otomatik tüm maillerin içerisine eklenebilme ihtimali var mı? yardımcı olabilir misiniz?
teşekkürler
. . .

Düz yazı şeklinde
Ad Soyad
Telefon
Adres bilgilerini eklemek isterseniz kolayca yapılabilir.

. . .
 
Katılım
25 Ağustos 2010
Mesajlar
46
Excel Vers. ve Dili
Ofice 2013
Ttürkçe
Altın Üyelik Bitiş Tarihi
21-09-2024
Düz yazı şeklinde olması yeterli.
 

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,892
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
. . .

Hangi mesajdaki dosyayı kullanıyorsunuz. Link ekleyebilir misiniz veya
kendi tablonuz varsa onuda ekleyebilirsiniz.

. . .
 
Katılım
25 Ağustos 2010
Mesajlar
46
Excel Vers. ve Dili
Ofice 2013
Ttürkçe
Altın Üyelik Bitiş Tarihi
21-09-2024
Mail İmza

. . .

Hangi mesajdaki dosyayı kullanıyorsunuz. Link ekleyebilir misiniz veya
kendi tablonuz varsa onuda ekleyebilirsiniz.

. . .

Hüseyin Bey,

Dosyayı ekledim. imzanın dışında tablo içine bir not yazdım onu yapmak mümkünmüdür?
 

Ekli dosyalar

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,892
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
. . .

Kod:
With objMail
    .To = SMG.Cells(i, "E").Value
    .CC = ""
    .Subject = "Mutabakat Mektubu"
 [COLOR="Blue"]   .body = Sheets("İmza").Range("A1")[/COLOR]
   [COLOR="SeaGreen"] '.body = Sheets("İmza").Range("A1")&chr(10)&Sheets("İmza").Range("A2")&chr(10)&Sheets("İmza").Range("A3")[/COLOR]
    .Attachments.Add yol
    .Save
    '.Display
    .Send
End With
Mavi satırı ilave ederek deneyiniz.
Alt alta metin eklemek için yeşil satırı aktif ederek deneyiniz.

Mutabık olmayanları filtre ile mi ekrana alıyorsunuz.

. . .
 
Katılım
25 Ağustos 2010
Mesajlar
46
Excel Vers. ve Dili
Ofice 2013
Ttürkçe
Altın Üyelik Bitiş Tarihi
21-09-2024
evet filtre ile ekrana alıyorum
 
Katılım
25 Ağustos 2010
Mesajlar
46
Excel Vers. ve Dili
Ofice 2013
Ttürkçe
Altın Üyelik Bitiş Tarihi
21-09-2024
Hüseyin Bey,

Bu ilave makroyu mevcut makronun içerisine mi ilave edeceğiz? kusura bakmayın çok fazla bilgim yok bu konularda :-(
 
Katılım
25 Ağustos 2010
Mesajlar
46
Excel Vers. ve Dili
Ofice 2013
Ttürkçe
Altın Üyelik Bitiş Tarihi
21-09-2024
kusura bakmayın şimdi gördüm ilave ettim makroyu
 

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,892
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
. . .

Filtre işlemi için şu kodları deneyiniz.

Kod:
Sub KOD()
    
    'NOT: TOOLS-REFERENCES TIKLA
    'MİCROSOFT OUTLOOK 12.0 İŞARETLİ OLMALI
    On Error Resume Next
    Dim SD As Worksheet
    Dim SM As Worksheet
    Dim SMG As Worksheet
    Dim SR As Worksheet
    Set SD = Sheets("data")
    Set SM = Sheets("mizan")
    Set SMG = Sheets("mail gönder")
    Set SR = Sheets("rapor")
    
    If Selection.Column <> 3 Then Exit Sub
    With Selection
        ilk_sat = .Row
        son_sat = .Rows.Count + ilk_sat - 1
    End With
    
    For i = ilk_sat To son_sat
     [COLOR="Blue"]   If Rows(i).EntireRow.Hidden = False Then[/COLOR]
            If SMG.Cells(i, "C") <> "" Then
                For a = 2 To SM.Cells(Rows.Count, "B").End(3).Row
                    
                    If SMG.Cells(i, "C") = SM.Cells(a, "B") Then
                        
                        SD.Range("B19") = SM.Cells(a, "B")
                        
                        If SM.Cells(a, "E") = "" Then
                            SD.Range("C26") = "TL"
                        Else
                            SD.Range("C26") = SM.Cells(a, "E")
                        End If
                        
                        If SM.Cells(a, "C") > 0 Then
                            SD.Range("B26") = SM.Cells(a, "C")
                            SD.Range("D26") = "BORÇ"
                        Else
                            SD.Range("B26") = SM.Cells(a, "C")
                            SD.Range("D26") = "ALACAK"
                        End If
                        
                        yol = CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & SMG.Cells(i, "A").Row & ".pdf"
                        
                        SD.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                        yol, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                        OpenAfterPublish:=False
                        
                        With Application
                            .EnableEvents = False
                            .ScreenUpdating = False
                        End With
                        
                        Dim objOutlook As Object
                        Dim objMail As Object
                        Set objOutlook = CreateObject("Outlook.Application")
                        Set objMail = objOutlook.CreateItem(0)
                        With objMail
                            .To = SMG.Cells(i, "E").Value
                            .CC = ""
                            .Subject = "Mutabakat Mektubu"
                   [COLOR="Blue"]         .body = Sheets("İmza").Range("A1")[/COLOR]
                            .Attachments.Add yol
                            .Save
                            '.Display
                            .Send
                        End With
                        
                        Kill yol
                        
                        sonsat = SR.Cells(Rows.Count, "A").End(3).Row + 1
                        SR.Cells(sonsat, "A") = SMG.Cells(i, "C")
                        SR.Cells(sonsat, "B") = SMG.Cells(i, "D")
                        SR.Cells(sonsat, "C") = Now
                        
                        Exit For
                        
                        Else: End If
                    Next a
                    Else: End If
           [COLOR="Blue"]     End If[/COLOR]
            Next i
            
            Set objMail = Nothing
            Set objOutlook = Nothing
            
            With Application
                .EnableEvents = True
                .ScreenUpdating = True
            End With
            
End Sub
. . .
 
Katılım
25 Ağustos 2010
Mesajlar
46
Excel Vers. ve Dili
Ofice 2013
Ttürkçe
Altın Üyelik Bitiş Tarihi
21-09-2024
Günaydın Hüseyin Bey,

Ellerinize sağlık çok teşekkürler
 
Katılım
25 Ağustos 2010
Mesajlar
46
Excel Vers. ve Dili
Ofice 2013
Ttürkçe
Altın Üyelik Bitiş Tarihi
21-09-2024
Günaydın Hüseyin Bey,

Mail adresi olanlara mutabakatları otomatik Pdf yapıp mail gönderebiliyorum. peki faks numarası olanlara otomatik tanımlı faks cihazı üzerinden Pdf yapıp faks göndermek mümkün mü?
 

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,892
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
Günaydın Hüseyin Bey,

Mail adresi olanlara mutabakatları otomatik Pdf yapıp mail gönderebiliyorum. peki faks numarası olanlara otomatik tanımlı faks cihazı üzerinden Pdf yapıp faks göndermek mümkün mü?
. . .

Mümkün ancak bu ayarlama kullanmış olduğunuz fax cihazına göre değişiklik gösteriyor.

HP Laserjet serisindense yapabiliriz.

. . .
 
Katılım
25 Ağustos 2010
Mesajlar
46
Excel Vers. ve Dili
Ofice 2013
Ttürkçe
Altın Üyelik Bitiş Tarihi
21-09-2024
Kyecore m6526 cdn kullanıyorum. mevcutta excelden tek tek faks gönderebiliyorum sizin exceldeki mutabakat mektubu formatınızda mail adresi olanları otomatik toplu pdf e çevirim mail atıyor ama mail adresi yerine faks numarası yazılsa bu faks yazıcısı üzerinden nasıl otomatik gönderimini sağlayabiliriz mail de olduğu gibi? makromu yazmak gerekir?
 

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,892
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
. . .

Yazıcı ayarlarınızı bilmediğim için net birşey söyleyemem.
HP 1536 modeli için yapmış olduğum yazılım şu şekilde çalışıyor.





. . .
 
Katılım
25 Ağustos 2010
Mesajlar
46
Excel Vers. ve Dili
Ofice 2013
Ttürkçe
Altın Üyelik Bitiş Tarihi
21-09-2024
Hüseyin Bey merhaba,

İlginiz için çok teşekkür ederim. rica etsem dosyayı ekleyebilirmisiniz?
 
Katılım
25 Ağustos 2010
Mesajlar
46
Excel Vers. ve Dili
Ofice 2013
Ttürkçe
Altın Üyelik Bitiş Tarihi
21-09-2024
. . .

Filtre işlemi için şu kodları deneyiniz.

Kod:
Sub KOD()
    
    'NOT: TOOLS-REFERENCES TIKLA
    'MİCROSOFT OUTLOOK 12.0 İŞARETLİ OLMALI
    On Error Resume Next
    Dim SD As Worksheet
    Dim SM As Worksheet
    Dim SMG As Worksheet
    Dim SR As Worksheet
    Set SD = Sheets("data")
    Set SM = Sheets("mizan")
    Set SMG = Sheets("mail gönder")
    Set SR = Sheets("rapor")
    
    If Selection.Column <> 3 Then Exit Sub
    With Selection
        ilk_sat = .Row
        son_sat = .Rows.Count + ilk_sat - 1
    End With
    
    For i = ilk_sat To son_sat
     [COLOR="Blue"]   If Rows(i).EntireRow.Hidden = False Then[/COLOR]
            If SMG.Cells(i, "C") <> "" Then
                For a = 2 To SM.Cells(Rows.Count, "B").End(3).Row
                    
                    If SMG.Cells(i, "C") = SM.Cells(a, "B") Then
                        
                        SD.Range("B19") = SM.Cells(a, "B")
                        
                        If SM.Cells(a, "E") = "" Then
                            SD.Range("C26") = "TL"
                        Else
                            SD.Range("C26") = SM.Cells(a, "E")
                        End If
                        
                        If SM.Cells(a, "C") > 0 Then
                            SD.Range("B26") = SM.Cells(a, "C")
                            SD.Range("D26") = "BORÇ"
                        Else
                            SD.Range("B26") = SM.Cells(a, "C")
                            SD.Range("D26") = "ALACAK"
                        End If
                        
                        yol = CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & SMG.Cells(i, "A").Row & ".pdf"
                        
                        SD.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                        yol, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                        OpenAfterPublish:=False
                        
                        With Application
                            .EnableEvents = False
                            .ScreenUpdating = False
                        End With
                        
                        Dim objOutlook As Object
                        Dim objMail As Object
                        Set objOutlook = CreateObject("Outlook.Application")
                        Set objMail = objOutlook.CreateItem(0)
                        With objMail
                            .To = SMG.Cells(i, "E").Value
                            .CC = ""
                            .Subject = "Mutabakat Mektubu"
                   [COLOR="Blue"]         .body = Sheets("İmza").Range("A1")[/COLOR]
                            .Attachments.Add yol
                            .Save
                            '.Display
                            .Send
                        End With
                        
                        Kill yol
                        
                        sonsat = SR.Cells(Rows.Count, "A").End(3).Row + 1
                        SR.Cells(sonsat, "A") = SMG.Cells(i, "C")
                        SR.Cells(sonsat, "B") = SMG.Cells(i, "D")
                        SR.Cells(sonsat, "C") = Now
                        
                        Exit For
                        
                        Else: End If
                    Next a
                    Else: End If
           [COLOR="Blue"]     End If[/COLOR]
            Next i
            
            Set objMail = Nothing
            Set objOutlook = Nothing
            
            With Application
                .EnableEvents = True
                .ScreenUpdating = True
            End With
            
End Sub
. . .


Hüseyin Bey günaydın,

ekteki makroda bi hata ile karşılaştım.

aynı cariye ait iki kayıt olduğunda örnegin,

x a.ş. 500 tl Borç
x a.ş. 750 Eur Alacak şeklinde olduğunda mutabakat giderken her ikisinde de borç olarak gidiyor. aslında eur olan alacak. rakamı doğru getiriyor ama döviz tipini tl olan ile aynı yapıyor. makroda nasıl bir revize yapmak gerekiyor. yardımcı olabilirmisiniz?
 
Üst