cari mutabakat mektubu

Emir Hüseyin Çoban · 14 Kasım 2014

. . .

Maile ikinci bir ek olarakta yapabiliriz veya
tek ek pdf içinde formunda 2. sayfası olarakta yapabiliriz.

Hangisinin yapımı ve kullanımı daha kolay kullanışlı olur emin değilim.

. . .

bydogannn · 14 Kasım 2014

Maile ıkıncı bı ek olarak daha güzel olmazmıdır hüseyin bey

Emir Hüseyin Çoban · 14 Kasım 2014

. . .

Dosyanız ektedir.

Ancak örnek dosyada BA ve BS formunda olan cari olmadığı için test edemedim. İnceleyiniz.

. . .

bydogannn · 14 Kasım 2014

Çok Şahane olmuş Hüseyin bey Teşekkür ederım

Bu aradaAynı fırmadan Hem BA hemde BS varsa ona gore fatura dökümü ayarlıyo dımı

Emir Hüseyin Çoban · 14 Kasım 2014

. . .

Kodlamayı o şekilde yaptım ancak örnekte o şekilde veri olmadığı için deneyemedim.

Gönderim işlemini bir defa da 10-15' den fazla yapmazsanız tablo çok kasmaz.

. . .

bydogannn · 14 Kasım 2014

tamamdır hüseyin bey elınıze kolunuza emeğinize sağlık

bydogannn · 14 Kasım 2014

...

Hüseyın bey BA olan hıtıt seramıkte ıkı form gelırken BS olan ÖZVARDAR da tek form gelıyo rıca etsem kontrol edebılırmısınız

Emir Hüseyin Çoban · 15 Kasım 2014

Data sayfasında vardar A tanımlı
Döküm sayfasında S tanımlı.

Aynı olmadıkları için döküm formu çıkmıyor.

bydogannn · 15 Kasım 2014

Pekı bu gonderdığım outlook ımza kodunu çalışmaya ekleyebılme sansımız varmıdır

Function RangetoHTML(rng As Range)
' By Ron de Bruin.
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x

ublishsource=", _
"align=left x

ublishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function

Emir Hüseyin Çoban · 15 Kasım 2014

. . .

Mesajlarda kod belirtirken Code tagını kullanın. İletilerinizin daha okunaklı olmasını sağlayacaktır.

Paylaştığınız kodda imza ile ilgili bir işlem yok.

Mevcut outlooktaki imzanızı bu maillere eklemek isterseniz biraz zahmetli.
Ancak bu maillerin içinde resim hariç, ad soyad, tel ,fax, web adresi olsun yeterli derseniz basit. İlave edebiliriz.

. . .

bydogannn · 1 Aralık 2014

...
Hüseyin bey yaptığımız çalışmada bi kaç değişiklikle çok güzel hale geldı yalnız buna mail gönder sayfasında ilgili kutucuğu seçtiğimizde göndermek yerıne pdf oluşturup acıcak bı buton calışması için bana yardımcı olabılırmısınız

.....

Emir Hüseyin Çoban · 1 Aralık 2014

. . .

PDF oluşturup mail gönder ekranını mı açacak yoksa PDF dosyasını mı açacak.

Tablo görsel olarak hoş olmuş ancak gereksiz olarak dosya boyutu şişmiş.

. . .

bydogannn · 1 Aralık 2014

...

İlgili cariyi seçip pdf görüntüle butonuna basıldığında PDF olarak BA -BS formunu acması yeterlı hüseyin bey

Emir Hüseyin Çoban · 2 Aralık 2014

. . .

Kod:

Sub KOD_2()
    
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Dim SM As Worksheet: Set SM = Sheets("MAIL GONDER")
    Dim SF As Worksheet: Set SF = Sheets("FORM")
    
    For i = 3 To SM.Cells(Rows.Count, "G").End(3).Row
        If SM.Cells(i, "G") = True Then
            
            isim = Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(SM.Cells(i, "D"), "/", "-"), "\", "-"), ":", "-"), "<", "-"), ">", "-"), "*", "-"), "?", "-"), "|", "-"), """", "-"), 11) & "_" & Format(Now, "ddmmyyyy_hhmmss") & ".pdf"
            yol = CreateObject("WScript.Shell").specialfolders("Desktop") & "\"
            
            SF.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            yol & isim, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
            
        End If
    Next i
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
End Sub

. . .

bydogannn · 2 Aralık 2014

....

tam istediğim gibi olmus hüseyin bey emeğinize sağlık, bide butonunda sıkıntım var burda gelen ekranda ara kısmında sütünları, konum kısmında değerleri, Büyük küçük harf duyarlı yapmadan istediğim cariye gitmiyo baska bı kod varmıdır acaba bildiğiniz

Emir Hüseyin Çoban · 2 Aralık 2014

. . .

FİND komutu ile büyük/küçük harf ayırmaksızın arama yapabilirsiniz.

. . .

bydogannn · 2 Aralık 2014

Tskler hüseyin bey, bu arada pdf görüntüleme ile ilgi sıkıntımız var,

sectığım carının formu yerıne en son maıl gondermek için sectığım carının formunu getırıyo

Emir Hüseyin Çoban · 2 Aralık 2014

. . .

Birazcık kurcalasanız kendinizde yapabilirsiniz.

Mevcut mail gönderme kodlarından mail ile ilgili kısımları silerekte yapabilirsiniz.

Akşam müsait olduğumda üzerinde çalışır eklerim.

. . .

Emir Hüseyin Çoban · 2 Aralık 2014

. . .

Kod:

Sub KOD_PDF()
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Dim SM As Worksheet: Set SM = Sheets("MAIL GONDER")
    Dim SF As Worksheet: Set SF = Sheets("FORM")
    Dim SD As Worksheet: Set SD = Sheets("DATA")
    Dim SG As Worksheet: Set SG = Sheets("GONDERILELER")
    Dim SD1 As Worksheet: Set SD1 = Sheets("FATURA DÖKÜMÜ")
    Dim SD2 As Worksheet: Set SD2 = Sheets("FATURA DÖKÜM FORM")
    For i = 3 To SM.Cells(Rows.Count, "G").End(3).Row
        
[COLOR="Green"]        ' MsgBox ("test")
        'MsgBox ("f" & Sayfa4.ListObjects("Onay Kutusu 1") + "")
        
        ' If SM.Cells(i, "A") = "x" Or SM.Cells(i, "A") = "X" Then[/COLOR]
        If SM.Range("G" & i) = True Then
[COLOR="Green"]            'If SM.Cells(i, "E") Like "*@*" Then[/COLOR]
            
            satır = Replace(SM.Cells(i, "D").FormulaLocal, "=DATA!C", "")
            
            SF.Range("C13") = "SAYIN, " & SD.Cells(satır, "C")
            SF.Range("C15") = "Adres : " & SD.Cells(satır, "D")
            SF.Range("C16") = "İl : " & SD.Cells(satır, "J") & "  | İlçe : " & SD.Cells(satır, "K")
            SF.Range("C17") = "Tel : " & SD.Cells(satır, "E") & "  | Fax : " & SD.Cells(satır, "F")
            SF.Range("C18") = "VD : " & SD.Cells(satır, "H") & " | VKN : " & SD.Cells(satır, "I")
            SF.Range("E27") = SD.Cells(satır, "M")
            SF.Range("E28") = SD.Cells(satır, "L") & " AD "
            
            If SD.Cells(satır, "A") = "A" Then
                SF.Range("C27") = "BA TUTAR"
                SF.Range("D27") = "="
                SF.Range("C28") = "BA BELGE SAYISI"
                SF.Range("D28") = "="
                SF.Range("D23") = " Tarihi itibariyle nezdimizdeki BA Form detayları aşağıdaki gibidir."
            Else
                SF.Range("C27") = "BS TUTAR"
                SF.Range("D27") = "="
                SF.Range("C28") = "BS BELGE SAYISI"
                SF.Range("D28") = "="
                SF.Range("D23") = " Tarihi itibariyle nezdimizdeki BS Form detayları aşağıdaki gibidir."
            End If
            
       [COLOR="Green"]     'kime = SM.Cells(i, "E")[/COLOR]
            isim = Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(SD.Cells(satır, "C"), "/", "-"), "\", "-"), ":", "-"), "<", "-"), ">", "-"), "*", "-"), "?", "-"), "|", "-"), """", "-"), 11) & "_" & Format(Now, "ddmmyyyy_hhmmss") & ".pdf"
            yol = CreateObject("WScript.Shell").specialfolders("Desktop") & "\"
            
            SF.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            yol & isim, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            [COLOR="Blue"]OpenAfterPublish:=True[/COLOR]
            
[COLOR="Green"]            ''''' DÖKÜM SAYFASI ''''''''
            '                sart1 = SD.Cells(satır, "C")
            '                sart2 = SD.Cells(satır, "A")
            '
            '                SD2.Range("A12:E" & Rows.Count).ClearContents
            '                satırno = 12
            '                SD2.Range("C7") = sart1
            '                kontrol = 0
            '                For a = 2 To SD1.Cells(Rows.Count, "C").End(3).Row
            '                    If SD1.Cells(a, "C") = sart1 And SD1.Cells(a, "A") = sart2 Then
            '                        kontrol = 1
            '                        SD2.Cells(satırno, "A") = satırno - 11
            '                        SD2.Cells(satırno, "B") = SD1.Cells(a, "B")
            '                        SD2.Cells(satırno, "C") = SD1.Cells(a, "C")
            '                        SD2.Cells(satırno, "D") = SD1.Cells(a, "D")
            '                        SD2.Cells(satırno, "E") = SD1.Cells(a, "E")
            '                        satırno = satırno + 1
            '                    End If
            '                Next a
            '                SD2.Cells(satırno + 1, "C") = "Genel Toplam : "
            '                SD2.Cells(satırno + 1, "E") = WorksheetFunction.Sum(SD2.Range("E12:E" & satırno))
            '                If kontrol = 1 Then
            '                isim2 = "Fatura_Listesi_" & satır & ".pdf"
            '                SD2.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            '                yol & isim2, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            '                OpenAfterPublish:=False
            '                End If
            '                ''''' ////////////  ''''''''
            '                Dim objOutlook As Object
            '                Dim objMail As Object
            '                Set objOutlook = CreateObject("Outlook.Application")
            '                Set objMail = objOutlook.CreateItem(0)
            '                With objMail
            '                    .Display
            '                    .To = kime
            '                    .CC = ""
            '                    .Subject = "B Formu Mutabakatı"
            '
            '                    .HtmlBody = SF.Range("C13") & Chr(10) & "<br>" & "<br>""<strong>Muhasebe Servisi Dikkatine!</strong>" & "<br>" & "<br>" & _
            '                    Format(SF.Range("C23"), "MMMM YYYY") & SF.Range("D23") & "<br>" & "<br>" & _
            '                    SF.Range("C27") & " : " & SF.Range("E27") & " TL" & "<br>" & _
            '                    SF.Range("C28") & " : " & SF.Range("E28") & Chr(10) & Chr(10) & _
            '                    SF.Range("B41") & "<br>" & "<br>" & _
            '                  "<strong>MUTABAKAT MEKTUBU ve FATURA LİSTESİ MAİL EKİNDEDİR.LÜTFEN MUTABIK OLUP OLMADIĞIMIZI BİLDİRMENİZİ RİCA EDERİZ...</strong>" & "<br>" & _
            '                  "<br>" & _
            '                    "İyi çalışmalar, Kolay gelsin..." & .HtmlBody
            '
            '                    .Attachments.Add yol & isim
            '                    .Attachments.Add yol & isim2
            '
            '                    .Save
            '                    .Send
            '                End With
            '                SGsat = SG.Cells(Rows.Count, "A").End(3).Row + 1
            '                SG.Cells(SGsat, "A") = SD.Cells(satır, "C")
            '                SG.Cells(SGsat, "B") = SM.Cells(i, "D")
            '                SG.Cells(SGsat, "C") = Now
            '                Kill yol & isim
            '                Kill yol & isim2
            '            End If[/COLOR]
        End If
    Next i
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

. . .

bydogannn · 2 Aralık 2014

dediğiniz gibi üzerinde biraz oynamayla istediğim gibi oldu tskler hüseyin bey

cari mutabakat mektubu

Emir Hüseyin Çoban

Destek Ekibi

bydogannn

Emir Hüseyin Çoban

Destek Ekibi

Ekli dosyalar

bydogannn

Emir Hüseyin Çoban

Destek Ekibi

bydogannn

bydogannn

Ekli dosyalar

Emir Hüseyin Çoban

Destek Ekibi

bydogannn

Emir Hüseyin Çoban

Destek Ekibi

bydogannn

Ekli dosyalar

Emir Hüseyin Çoban

Destek Ekibi

bydogannn

Emir Hüseyin Çoban

Destek Ekibi

bydogannn

Emir Hüseyin Çoban

Destek Ekibi

bydogannn

Emir Hüseyin Çoban

Destek Ekibi

Emir Hüseyin Çoban

Destek Ekibi

bydogannn