• DİKKAT

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

Buton yardımı ile veri aktarma ve e-mail yollama

Katılım
30 Kasım 2008
Mesajlar
51
Excel Vers. ve Dili
2007 türkçe
Merhabalar Arkadaşlar;

Daha önce bir kasa programı göndermiştim. fakat Ömer beyin tavsiyelerini dinleyerek yeni bir çalışma hazırladım gün sonu kasa raporu grafik tasarımlı dır. Fakat İhtiyacım olan şey bir kaç işlemi buton yardımı ile kullanmak. Eklediğim dosya içerisinde tüm açıklamalar mevcuttur. Aylık tablodan belirli verileri gün sonundaki raporda belirli yerlere aktarması ve bu dosyayı PDF oluşturup E-mail ile göndermektir. E-mail yönlendirmesini yaptım fakat oluşturulacak olan pdf dosyası olmadığı için ekleme yapamadım. Bu konuda yardımlarınıza ihtiyacım var bu 7. aya bu programı kullandırmak istiyorum acil yardımcı olursanız çok sevinirim. (Dosyada herhangi bir şifre yoktur)
Ekli dosyayı görüntüle KASA RAPORU.rar
 
yardım edecek hiç kimse yok mu kaç gündür burada çırpınıyorum. :(
 
yardım edecek hiç kimse yok mu kaç gündür burada çırpınıyorum. :(

Merhaba
Sorunuz ile ilgili ilk mesajınız ve son mesajınız arasında bir gün(24 saat) bile geçmemiş.

Bir nolu mesajınızdaki bilgiler tutarsız günlük rapor sayfasında C21 den aşağıya doğru olan verileri nereden alıyorsunuz zira c21 hücresindeki veri b21 hücresindeki banka adı ile 7.ay sayfasındaki tutar farklı.

Örnek dosyanızdaki bilgiler bire bir aynı olsun ki size cevap yazacaklar için birazcık kolaylık olsun yoksa kim nasıl yardımcı olacak size.

not: Bence sorularınızı tek tek aşama aşama sorun ve gelen cevaplardan sonra kendiniz aşamaları birleştirebilirsiniz.

Örnek olarak ben 7,ay sayfasındaki u3 hücresindeki tarihi ilgili sayfada aratıp rapor sayfasına yazdıran kodu ekliyorum.

kodları mutlaka aylar sayfasında çalıştırın.

kod:

Kod:
Sub aktar()

Sheets("Günlük Rapor").Range("C21:C28").ClearContents
aranan1 = CDate(Cells(3, "u").Value)
MsgBox aranan1
For r = 3 To 33
If aranan1 = CDate(Cells(r, 1).Value) Then
For i = 8 To 15
Sheets("Günlük Rapor").Cells(i + 13, "c").Value = Cells(r, i).Value

Next i
End If
Next r
MsgBox " Düzenleme Tamanlanmıştır..."

End Sub
 
Merhaba
Sorunuz ile ilgili ilk mesajınız ve son mesajınız arasında bir gün(24 saat) bile geçmemiş.

Bir nolu mesajınızdaki bilgiler tutarsız günlük rapor sayfasında C21 den aşağıya doğru olan verileri nereden alıyorsunuz zira c21 hücresindeki veri b21 hücresindeki banka adı ile 7.ay sayfasındaki tutar farklı.

Örnek dosyanızdaki bilgiler bire bir aynı olsun ki size cevap yazacaklar için birazcık kolaylık olsun yoksa kim nasıl yardımcı olacak size.

not: Bence sorularınızı tek tek aşama aşama sorun ve gelen cevaplardan sonra kendiniz aşamaları birleştirebilirsiniz.

Örnek olarak ben 7,ay sayfasındaki u3 hücresindeki tarihi ilgili sayfada aratıp rapor sayfasına yazdıran kodu ekliyorum.

kodları mutlaka aylar sayfasında çalıştırın.

kod:

Kod:
Sub aktar()

Sheets("Günlük Rapor").Range("C21:C28").ClearContents
aranan1 = CDate(Cells(3, "u").Value)
MsgBox aranan1
For r = 3 To 33
If aranan1 = CDate(Cells(r, 1).Value) Then
For i = 8 To 15
Sheets("Günlük Rapor").Cells(i + 13, "c").Value = Cells(r, i).Value

Next i
End If
Next r
MsgBox " Düzenleme Tamanlanmıştır..."

End Sub

Söylediklerinizde çok haklısınız. Fakat Mağazalara 01/07/2016 tarihi itibarile bu programı kullandırtmam gerekiyor. Mazur görün lütfen. Belirtmiş olduğunuz sayfalardaki veriler birbirini tutmaması sadece deneme olarak formül doğruluğunu yapmaya çalıştım. İşleyiş şöyle 7. ay veya 8. ay daki sayfalara manuel olarak giriş yapıyorlar sağ tarafta ise hangi günün raporunu alacaklarsa tarihi seçip oradaki bilgileri günlük raporun içerisine atması gerekiyor. Örneğin akbank 500 tl ise oradaki tutar rapor sayfasında akbank kısmına bu miktarı yazması gerekiyor. üst tarafa ise ben formülle kredi kartı satışları toplama formülü yazdı. aylık tabloda bulunan hücreler sadece rapor sayfasındaki yerlere gelmesi yeterli. Sizin göndermiş olduğunuz Makroyu aylık tablodaki butona ekledim fakat aktarma yapmadı.
 
Halit3 bey Makroyu çalıştırdım doğru tam istediğim gibi çalışıyor. sadece nakit satış masraf ve muhtelif kısmı yok aktarmada

7, Ay tablo Günlük Rapor
C3 HÜCRESİ --------- C17 HÜCRESİNE
D3 HÜCRESİ --------- C13 HÜCRESİNE
E3 HÜCRESİ --------- C15 HÜCRESİNE GELECEK Birde butona bastığımızda aktarma yaptıktan sonra günlük rapor sayfasına yönlendirmek mümkün müdür?
 
kod:

Kod:
Sub aktar()

Sheets("Günlük Rapor").Range("C21:C28").ClearContents

Sheets("Günlük Rapor").Range("C13").ClearContents
Sheets("Günlük Rapor").Range("C15").ClearContents
Sheets("Günlük Rapor").Range("C17").ClearContents

aranan1 = CDate(Cells(3, "u").Value)
MsgBox aranan1


For r = 3 To 33
If aranan1 = CDate(Cells(r, 1).Value) Then
For i = 8 To 15
Sheets("Günlük Rapor").Cells(i + 13, "c").Value = Cells(r, i).Value

Next i

Sheets("Günlük Rapor").Cells(17, "c").Value = Cells(r, "c").Value
Sheets("Günlük Rapor").Cells(13, "c").Value = Cells(r, "d").Value
Sheets("Günlük Rapor").Cells(15, "c").Value = Cells(r, "e").Value

End If
Next r

Sheets("Günlük Rapor").Select
MsgBox " Düzenleme Tamanlanmıştır..."

End Sub
 
kod:

Kod:
Sub aktar()

Sheets("Günlük Rapor").Range("C21:C28").ClearContents

Sheets("Günlük Rapor").Range("C13").ClearContents
Sheets("Günlük Rapor").Range("C15").ClearContents
Sheets("Günlük Rapor").Range("C17").ClearContents

aranan1 = CDate(Cells(3, "u").Value)
MsgBox aranan1


For r = 3 To 33
If aranan1 = CDate(Cells(r, 1).Value) Then
For i = 8 To 15
Sheets("Günlük Rapor").Cells(i + 13, "c").Value = Cells(r, i).Value

Next i

Sheets("Günlük Rapor").Cells(17, "c").Value = Cells(r, "c").Value
Sheets("Günlük Rapor").Cells(13, "c").Value = Cells(r, "d").Value
Sheets("Günlük Rapor").Cells(15, "c").Value = Cells(r, "e").Value

End If
Next r

Sheets("Günlük Rapor").Select
MsgBox " Düzenleme Tamanlanmıştır..."

End Sub

Çok minnettarım size yardımlarınız için öğrenmek istiyorum 7. ay sayfasındaki bir veriyi rapor sayfasındaki belirli bir hücreye aktarmak için bu kodlara nasıl ekleyebilirim.
 
Çok minnettarım size yardımlarınız için öğrenmek istiyorum 7. ay sayfasındaki bir veriyi rapor sayfasındaki belirli bir hücreye aktarmak için bu kodlara nasıl ekleyebilirim.

örnek olarak
7.AY sayfasındaki B8 hücresindeki veriyi Günlük Rapor sayfasındaki A1 hücresine aktaran kod

Kod:
Sheets("Günlük Rapor").Cells(1, "a").Value = Sheets("7. AY").Cells(8, "b").Value
 
örnek olarak
7.AY sayfasındaki B8 hücresindeki veriyi Günlük Rapor sayfasındaki A1 hücresine aktaran kod

Kod:
Sheets("Günlük Rapor").Cells(1, "a").Value = Sheets("7. AY").Cells(8, "b").Value

Size her ne kadar teşekkür etsem azdır. Beni büyük bir ambargodan kurtardınız. Tekrardan Çok teşekkür ederim.

Sormak istediğim bir şey daha var Günlük Rapor sayfasında KAYDET VE YAZDIR BUTONU yapmıştım. sadece o sayfayı kaydet dediğimizde Pdf olarak tarihe göre kaydetmek mümkünmüdür. Kaydettikten sonra kaydedilen dosyaotomatik açılabilir mi yazdırmak için ?
 
kod:

Kod:
Sub savePDF()
Dim Yol As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Yol = ThisWorkbook.Path
isim = Cells(5, "c").Value
say = CreateObject("Scripting.FileSystemObject").getfolder(Yol).Files.Count + 1
sayfa = "Günlük Rapor" 'ActiveSheet.Name

Sheets(sayfa).PageSetup.PrintArea = ""
Sheets(sayfa).PageSetup.PrintArea = "$a$1"
Sheets(sayfa).PageSetup.PrintArea = "$A$1:$H$62"

If Sheets(sayfa).VPageBreaks.Count > 0 Then
Sheets(sayfa).VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
End If

Sheets(Array(sayfa)).Select

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Yol & "\" & isim & " " & say & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "işlem tamam"

End Sub
 
kod:

Kod:
Sub savePDF()
Dim Yol As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Yol = ThisWorkbook.Path
isim = Cells(5, "c").Value
say = CreateObject("Scripting.FileSystemObject").getfolder(Yol).Files.Count + 1
sayfa = "Günlük Rapor" 'ActiveSheet.Name

Sheets(sayfa).PageSetup.PrintArea = ""
Sheets(sayfa).PageSetup.PrintArea = "$a$1"
Sheets(sayfa).PageSetup.PrintArea = "$A$1:$H$62"

If Sheets(sayfa).VPageBreaks.Count > 0 Then
Sheets(sayfa).VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
End If

Sheets(Array(sayfa)).Select

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Yol & "\" & isim & " " & say & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "işlem tamam"

End Sub

Çok teşekkür ederim size programımı tamamladım sizin sayenizde tekrardan çok teşekkür ederim.
 
kod:

Kod:
Sub savePDF()
Dim Yol As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Yol = ThisWorkbook.Path
isim = Cells(5, "c").Value
say = CreateObject("Scripting.FileSystemObject").getfolder(Yol).Files.Count + 1
sayfa = "Günlük Rapor" 'ActiveSheet.Name

Sheets(sayfa).PageSetup.PrintArea = ""
Sheets(sayfa).PageSetup.PrintArea = "$a$1"
Sheets(sayfa).PageSetup.PrintArea = "$A$1:$H$62"

If Sheets(sayfa).VPageBreaks.Count > 0 Then
Sheets(sayfa).VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
End If

Sheets(Array(sayfa)).Select

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Yol & "\" & isim & " " & say & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "işlem tamam"

End Sub

hocam merhabalar

çok ufak bir sorunum kaldı sizi çok fazla rahatsız etmek istemedim çok araştırdım ama bulamadım. PDF formatı ile kaydet görüntüle butonu yapmıştık. alttaki butona ise mail olarak gönder butonu yapmıştım. ben bir kod ile seçili hücreleri mail olarak göndermeyi başardım fakat mail açıldığında bazı görsellerin yerlerinde kayma oldu. excelde pdf olark mail gönder diye birşey var buradan pdf formatında mail olarak gönderilebiliyor. Bu excelde gönder seçeneklerinden PDF ile gönder seçeneğinin makrosu varmıdır. dosyanın kayıtlı olduğu yeri göstermek zor oluyor. ben örnek dosyanın son halini yolluyorum size butona bastığımızda PDF oluşturacak ve bunu outlook ta ek dosya olarak eklenebilir mi?
 

Ekli dosyalar

Bir gmail hesabınız varsa kod aotlok açık olmadan da mail gönderiyor.

kodun kırmızı yerlerini kendinize göre doldurun.
Kod:
Sub yeni_mail_gönder()

msg2 = MsgBox("Mail göndermek istiyormusunuz.? ", vbYesNo + vbInformation, "u y a r ı !")

If msg2 = vbNo Then
Exit Sub
End If

Set objEmail = CreateObject("CDO.Message")

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
kullanici_sahibi = "[COLOR="Red"]kullanıcı adı yazılacak[/COLOR]"
kullanici_parola = "[COLOR="red"]parola yazılacak[/COLOR]"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

objEmail.Bcc = "[COLOR="red"]ibrahimdemir@ayakkabicity.com.tr[/COLOR]"
objEmail.To = "[COLOR="red"]muhasebe@ayakkabicity.com.tr[/COLOR]"


objEmail.From = kullanici_sahibi

objEmail.Subject = [COLOR="red"]Date - 1 & " TARİHLİ KASA RAPORU"[/COLOR]

objEmail.Htmlbody = "<b>" & "[COLOR="red"]GÜNLÜK KASA RAPORU" & Chr(13) & Chr(13) & " LÜTFEN RAPORU KONTROL EDİNİZ. İYİ ÇALIŞMALAR DİLERİM. "[/COLOR] & "<b>"
Yol = Sheets("Günlük Rapor").Cells(1, "m").Value

If CreateObject("Scripting.FileSystemObject").FileExists(Yol) = True Then
objEmail.Addattachment Yol
Else
MsgBox "dosya yok"
End If

With objEmail.Configuration.Fields

.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = kullanici_sahibi
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = kullanici_parola
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Update

End With
objEmail.Send
MsgBox "işlem tamam.", vbApplicationModal, "Bilgilendirme!"



End Sub

Açıklama
Pdf olarak dosyayı kayıt yaptıktan sonra M1 hücresine pdf dosyasının adresi kayıt yapılıyor ve kayıt yapılan pdf dosyasını mail gönder düğmesini tıklayınca mail gidiyor.

ayrıca mail göndermek için aşağıdaki linkleride irdeleyiniz.

http://www.excel.web.tr/f48/mail-gonderme-outlook-acylmadan-t155982.html

http://www.excel.web.tr/f48/mail-gonderme-exe-ve-excelde-t146494.html

http://www.excel.web.tr/f48/mail-gonderme-t139233.html
 

Ekli dosyalar

Bir gmail hesabınız varsa kod aotlok açık olmadan da mail gönderiyor.

kodun kırmızı yerlerini kendinize göre doldurun.
Kod:
Sub yeni_mail_gönder()

msg2 = MsgBox("Mail göndermek istiyormusunuz.? ", vbYesNo + vbInformation, "u y a r ı !")

If msg2 = vbNo Then
Exit Sub
End If

Set objEmail = CreateObject("CDO.Message")

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
kullanici_sahibi = "[COLOR="Red"]kullanıcı adı yazılacak[/COLOR]"
kullanici_parola = "[COLOR="red"]parola yazılacak[/COLOR]"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

objEmail.Bcc = "[COLOR="red"]ibrahimdemir@ayakkabicity.com.tr[/COLOR]"
objEmail.To = "[COLOR="red"]muhasebe@ayakkabicity.com.tr[/COLOR]"


objEmail.From = kullanici_sahibi

objEmail.Subject = [COLOR="red"]Date - 1 & " TARİHLİ KASA RAPORU"[/COLOR]

objEmail.Htmlbody = "<b>" & "[COLOR="red"]GÜNLÜK KASA RAPORU" & Chr(13) & Chr(13) & " LÜTFEN RAPORU KONTROL EDİNİZ. İYİ ÇALIŞMALAR DİLERİM. "[/COLOR] & "<b>"
Yol = Sheets("Günlük Rapor").Cells(1, "m").Value

If CreateObject("Scripting.FileSystemObject").FileExists(Yol) = True Then
objEmail.Addattachment Yol
Else
MsgBox "dosya yok"
End If

With objEmail.Configuration.Fields

.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = kullanici_sahibi
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = kullanici_parola
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Update

End With
objEmail.Send
MsgBox "işlem tamam.", vbApplicationModal, "Bilgilendirme!"



End Sub

Açıklama
Pdf olarak dosyayı kayıt yaptıktan sonra M1 hücresine pdf dosyasının adresi kayıt yapılıyor ve kayıt yapılan pdf dosyasını mail gönder düğmesini tıklayınca mail gidiyor.

ayrıca mail göndermek için aşağıdaki linkleride irdeleyiniz.

http://www.excel.web.tr/f48/mail-gonderme-outlook-acylmadan-t155982.html

http://www.excel.web.tr/f48/mail-gonderme-exe-ve-excelde-t146494.html

http://www.excel.web.tr/f48/mail-gonderme-t139233.html

Çok teşekkür ederim yardımlarınız için. Tam istediğim gibi fakat bütün mağazalarda kurumsal mailler kullanılıyor gmail hesabı değilde direk outlook ile gönderim yapılabilir mi?
 
sizin kodunuzu çalıştırdığımda "objEmail.Send" hatası veriyor
 
Aşağıdaki sizin kodunuz maail gönderiyorsa kırmızı yerleri ekledim benim gönderdiğim dosyada pdf oluşturun ve bu kodu çalıştırın.

Kod:
Sub mailgönder()

'ActiveSheet.Range("A1:H59").Select

ActiveWorkbook.EnvelopeVisible = True

With ActiveSheet.MailEnvelope

.Introduction = "GÜNLÜK KASA RAPORU" & Chr(13) & Chr(13) & " LÜTFEN RAPORU KONTROL EDİNİZ. İYİ ÇALIŞMALAR DİLERİM. "

[COLOR="Red"]Yol = Sheets("Günlük Rapor").Cells(1, "m").Value
If CreateObject("Scripting.FileSystemObject").FileExists(Yol) = True Then
.Attachments.Add Yol
Else
MsgBox "dosya yok"
End If[/COLOR]

.Item.To = "muhasebe@ayakkabicity.com.tr"

.Item.CC = "ibrahimdemir@ayakkabicity.com.tr "

.Item.Subject = Date - 1 & " TARİHLİ KASA RAPORU"

.Item.Send

End With

MsgBox "Mail Merkeze Gönderildi"
End Sub
 
Dediğiniz kodu kullandım fakat ".Attachments.Add Yol" kodunda hata verdi. dosya kaydını yapıyorum pdf oluşuyor m 1 hücresine adres doğru bir şekilde yazıyor fakat pdf eklenmiyor
 
Aşağıdaki sizin kodunuz maail gönderiyorsa kırmızı yerleri ekledim benim gönderdiğim dosyada pdf oluşturun ve bu kodu çalıştırın.

Kod:
Sub mailgönder()

'ActiveSheet.Range("A1:H59").Select

ActiveWorkbook.EnvelopeVisible = True

With ActiveSheet.MailEnvelope

.Introduction = "GÜNLÜK KASA RAPORU" & Chr(13) & Chr(13) & " LÜTFEN RAPORU KONTROL EDİNİZ. İYİ ÇALIŞMALAR DİLERİM. "

[COLOR="Red"]Yol = Sheets("Günlük Rapor").Cells(1, "m").Value
If CreateObject("Scripting.FileSystemObject").FileExists(Yol) = True Then
.Attachments.Add Yol
Else
MsgBox "dosya yok"
End If[/COLOR]

.Item.To = "muhasebe@ayakkabicity.com.tr"

.Item.CC = "ibrahimdemir@ayakkabicity.com.tr "

.Item.Subject = Date - 1 & " TARİHLİ KASA RAPORU"

.Item.Send

End With

MsgBox "Mail Merkeze Gönderildi"
End Sub

Dediğiniz kodu kullandım fakat ".Attachments.Add Yol" kodunda hata verdi. dosya kaydını yapıyorum pdf oluşuyor m 1 hücresine adres doğru bir şekilde yazıyor fakat pdf eklenmiyor
 
Birde böyle dene

Kod:
Sub mailgönder()

'ActiveSheet.Range("A1:H59").Select

ActiveWorkbook.EnvelopeVisible = True

With ActiveSheet.MailEnvelope

.Introduction = "GÜNLÜK KASA RAPORU" & Chr(13) & Chr(13) & " LÜTFEN RAPORU KONTROL EDİNİZ. İYİ ÇALIŞMALAR DİLERİM. "

.Item.To = "muhasebe@ayakkabicity.com.tr"

.Item.CC = "ibrahimdemir@ayakkabicity.com.tr "

.Item.Subject = Date - 1 & " TARİHLİ KASA RAPORU"

Yol = Sheets("Günlük Rapor").Cells(1, "m").Value
If CreateObject("Scripting.FileSystemObject").FileExists(Yol) = True Then
[COLOR="Red"].Item.Attachments.Add Yol[/COLOR]
Else
MsgBox "dosya yok"
End If

.Item.Send

End With

MsgBox "Mail Merkeze Gönderildi"
End Sub
 
Geri
Üst