Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Fonksiyonlar (http://www.excel.web.tr/forumdisplay.php?f=47)
-   -   cari mutabakat mektubu (http://www.excel.web.tr/showthread.php?t=143831)

cemto 15-10-2014 14:28

cari mutabakat mektubu
 
1 Eklenti(ler)
Merhaba, sitede araştırma yaptım ama detaylı yoktu , aylık olarak firmalar cari hesap mutabakat mektubu mail atmak istiyorum yalnız üç farklı para birimi bulunmakta detaylı anlatım dosya içinde var ilgilenen arkadaşlara teşekkürü borç bilirim.

Emir Hüseyin Çoban 15-10-2014 23:40

. . .

mail gönder sayfasında C sütununda göndermek istediğiniz müşterileri aralıksız seçin.
Örneğin C3:C5 sonra C6:C10 gibi.
Bunu gönderme işlemini 10-15 li gruplar halinde yapmanız için yaptım ki spama düşmeyin.

Firma ünvanları mizan ile aynı olmalı. (C ve B sütunları)

Data sayfanızın baskısını A4 sayfasına sığacak hale getirmenizde fayda var.

Kod:

Sub KOD()
   
    'NOT: TOOLS-REFERENCES TIKLA
    'MİCROSOFT OUTLOOK 12.0 İŞARETLİ OLMALI

   
    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
       
        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, "H") = "" Then
                        SD.Range("C26") = "TL"
                    Else
                        SD.Range("C26") = SM.Cells(a, "H")
                    End If
                   
                    If SM.Cells(a, "F") > 0 Then
                        SD.Range("B26") = SM.Cells(a, "F")
                        SD.Range("E26") = "BORÇ"
                    Else
                        SD.Range("B26") = SM.Cells(a, "G")
                        SD.Range("E26") = "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"
                        .Attachments.Add yol
                        .Save
                        '.Display
                        .Send
                    End With
                   
                    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
                Kill yol
               
                Else: End If
            Next i
           
            Set objMail = Nothing
            Set objOutlook = Nothing
           
            With Application
                .EnableEvents = True
                .ScreenUpdating = True
            End With
           
End Sub

. . .

cemto 16-10-2014 11:34

1 Eklenti(ler)
Alıntı:

Hüseyin Çoban tarafından gönderildi (Mesaj 781661)
. . .

mail gönder sayfasında C sütununda göndermek istediğiniz müşterileri aralıksız seçin.
Örneğin C3:C5 sonra C6:C10 gibi.
Bunu gönderme işlemini 10-15 li gruplar halinde yapmanız için yaptım ki spama düşmeyin.

Firma ünvanları mizan ile aynı olmalı. (C ve B sütunları)

Data sayfanızın baskısını A4 sayfasına sığacak hale getirmenizde fayda var.

Kod:

Sub KOD()
   
    'NOT: TOOLS-REFERENCES TIKLA
    'MİCROSOFT OUTLOOK 12.0 İŞARETLİ OLMALI

   
    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
       
        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, "H") = "" Then
                        SD.Range("C26") = "TL"
                    Else
                        SD.Range("C26") = SM.Cells(a, "H")
                    End If
                   
                    If SM.Cells(a, "F") > 0 Then
                        SD.Range("B26") = SM.Cells(a, "F")
                        SD.Range("E26") = "BORÇ"
                    Else
                        SD.Range("B26") = SM.Cells(a, "G")
                        SD.Range("E26") = "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"
                        .Attachments.Add yol
                        .Save
                        '.Display
                        .Send
                    End With
                   
                    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
                Kill yol
               
                Else: End If
            Next i
           
            Set objMail = Nothing
            Set objOutlook = Nothing
           
            With Application
                .EnableEvents = True
                .ScreenUpdating = True
            End With
           
End Sub

. . .




Hüseyin bey merhaba,

bilmiyorum hatırladınız mı daha öncede ba bs mutabakat formu ile ilgili yardımcı olmuştunuz çok kişi duasını aldınız inanın, bu çalışmaya o dosya üzerinden başladım ama verdiğiniz kodu onun üzerinde makroya yapıştırdım açılışta başka bir bağlantı var güncelle vs.. diye birşeyler çıkıyor sistem ve bende error verdim , o yüzden dosyayı yeni bir excel sayfası yaptım sayfa ayalarını yapıp daha detaylı belirgin bir açıklama ile yazdım ekledim şimdi rica etsem bu dosya içine ekleye bilir miyiz saatlerce uğraştım yapamadım , bir çok meslektaşın işine yarayacak bir çalışma olacak teşekkür ederim.

Emir Hüseyin Çoban 16-10-2014 11:59

1 Eklenti(ler)
. . .

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)

http://i.hizliresim.com/1npaRb.gif

. . .

cemto 16-10-2014 14:08

1 Eklenti(ler)
Alıntı:

Hüseyin Çoban tarafından gönderildi (Mesaj 781709)
. . .

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)

http://i.hizliresim.com/1npaRb.gif

. . .

hüseyin bey dosya ve gif dosyası çok güzel olmuş çok teşekkür ederim,

1) dosyayı incelediğimde , tl de sıkıntı yok ama dolar ve euro cinsinde mail atılacak tutar k ve l sütunu olması gerekiyor ( Döviz Borç Bakiyesi ,Döviz Alacak Bakiyesi )

2) birde maillin içine bir açıklama yazdım data klasörünün altına bunu 70- 89 arasındaki mailin içine yazma imkanımız varmı

Emir Hüseyin Çoban 16-10-2014 15:48

1 Eklenti(ler)
Alıntı:

cemto tarafından gönderildi (Mesaj 781728)
hüseyin bey dosya ve gif dosyası çok güzel olmuş çok teşekkür ederim,

1) dosyayı incelediğimde , tl de sıkıntı yok ama dolar ve euro cinsinde mail atılacak tutar k ve l sütunu olması gerekiyor ( Döviz Borç Bakiyesi ,Döviz Alacak Bakiyesi )

2) birde maillin içine bir açıklama yazdım data klasörünün altına bunu 70- 89 arasındaki mailin içine yazma imkanımız varmı

. . .

Dosyanız ektedir.

. . .

cemto 16-10-2014 17:45

Alıntı:

Hüseyin Çoban tarafından gönderildi (Mesaj 781738)
. . .

Dosyanız ektedir.

. . .

Hüseyin bey , mail gönder dediğimde outlook ta her biri için sayfa açıyor taslakta tutuyor otomatik göndermiyor

Emir Hüseyin Çoban 16-10-2014 17:49

. . .

Kodları incelerseniz .send satırı pasif yaptım ki ben denemeler yaparken sürekli mail atmaması için.
Sizde .Display satırını pasif yapıp, .send satırını aktif edin.

. . .

cemto 16-10-2014 18:05

Alıntı:

Hüseyin Çoban tarafından gönderildi (Mesaj 781764)
. . .

Kodları incelerseniz .send satırı pasif yaptım ki ben denemeler yaparken sürekli mail atmaması için.
Sizde .Display satırını pasif yapıp, .send satırını aktif edin.

. . .


Hüseyin bey kod işinden anlamıyorum bana çin yazısı gibi geliyor :) rica etsem o şekilde göndere bilirmisiniz teşekkür ederim

Emir Hüseyin Çoban 16-10-2014 19:15

Önce bir deneyin. Değişiklik yaptıktan sonra çalıştırarsk sonucu gözlemleyin.
Yine yapamazsanız yardımcı olalım.

.


Saat 17:08

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.