Cvp: Excel Kitaplar Arası Geçişte Problem - berduş - 10/05/2019
bu arada kodlar da kopyalanıyor sayfayla beraber yeni kitap-->yeni sayfa-->sadece 3-4 satırı kopyala yapsak daha hızlı ve kolay olmaz mı? diğerlerinin arka planda çalışan kodlara ihtiyacı var mı?
not: önerim sadece teorik nasıl yapılır bilmiyorum )
dilerim işinize yarar
Sub MailActiveSheet()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim i As Integer
i = ActiveCell.Row '<=========== Eklenen Satır i ile aktif satır belirlenip ona göre kopyalama yapılır
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ThisWorkbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
With Destwb
FileExtStr = ".xlsb": FileFormatNum = 50
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = " " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
'================>Eklenen<==========================================
Range(i & ":" & i).Copy Destwb.Worksheets("W.O KAYIT").Range("4:4") '<=========== Eklenen Satır sadece seçtiğiniz satırı kopyalar
Destwb.Worksheets("W.O KAYIT").Range("A5:Z993").Clear '<=========== Eklenen Satır Geriye kalanı siler
'================>Eklenen BİTTİ<==========================================
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = ""
.CC = ""
.BCC = ""
.Subject = "C&I BAKIM WORK ORDER"
.Body = "Sayın İlgililer" & vbNewLine & vbNewLine & "IT ile ilgili yeni oluşturulan iş emrini ekte görebilirsiniz." & vbNewLine & vbNewLine & "İyi Çalışmalar"
.Attachments.Add Destwb.FullName
'.Send
.Display
End With
On Error GoTo 0
.Close savechanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Cvp: Excel Kitaplar Arası Geçişte Problem - ertus35 - 10/05/2019
(10/05/2019, 04:21)haliliyas yazdı: bu arada kodlar da kopyalanıyor sayfayla beraber yeni kitap-->yeni sayfa-->sadece 3-4 satırı kopyala yapsak daha hızlı ve kolay olmaz mı? diğerlerinin arka planda çalışan kodlara ihtiyacı var mı?
not: önerim sadece teorik nasıl yapılır bilmiyorum )
dilerim işinize yarar
Sub MailActiveSheet()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim i As Integer
i = ActiveCell.Row '<=========== Eklenen Satır i ile aktif satır belirlenip ona göre kopyalama yapılır
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ThisWorkbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
With Destwb
FileExtStr = ".xlsb": FileFormatNum = 50
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = " " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
'================>Eklenen<==========================================
Range(i & ":" & i).Copy Destwb.Worksheets("W.O KAYIT").Range("4:4") '<=========== Eklenen Satır sadece seçtiğiniz satırı kopyalar
Destwb.Worksheets("W.O KAYIT").Range("A5:Z993").Clear '<=========== Eklenen Satır Geriye kalanı siler
'================>Eklenen BİTTİ<==========================================
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = ""
.CC = ""
.BCC = ""
.Subject = "C&I BAKIM WORK ORDER"
.Body = "Sayın İlgililer" & vbNewLine & vbNewLine & "IT ile ilgili yeni oluşturulan iş emrini ekte görebilirsiniz." & vbNewLine & vbNewLine & "İyi Çalışmalar"
.Attachments.Add Destwb.FullName
'.Send
.Display
End With
On Error GoTo 0
.Close savechanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Cvp: Excel Kitaplar Arası Geçişte Problem - ertus35 - 10/05/2019
Hocam emeğinize sağlık , çok güzel hazırlamışsınız,uğraşmışsınız. Fakat mailde ek olmasına gerek yok. Yapmak istediğim Sadece örnek: A4 ile L4 arasınındaki iş emrini mail body'sine yazmasıdır. Örneği eklşyorum.
Saygılarımla
[img][/img]
Cvp: Excel Kitaplar Arası Geçişte Problem - ertus35 - 10/05/2019
resim geldi mi acaba. Yükleyemedim sanırım resmi.
Cvp: Excel Kitaplar Arası Geçişte Problem - berduş - 10/05/2019
dilerim işinize yarar)
Cvp: Excel Kitaplar Arası Geçişte Problem - ertus35 - 10/05/2019
(10/05/2019, 16:54)ertus35 yazdı: resim geldi mi acaba. Yükleyemedim sanırım resmi.
(10/05/2019, 18:22)haliliyas yazdı: dilerim işinize yarar)
Halil Bey,
Tabiki işime çok yarıyor. Çok sağ olun. Önce Sizin oluşturduğunuzu atacağım. Sonra benim son olarak sizden ricamı atacağım.
Tüm satırı aldığında tablo çevreleri ve gizli sütunlardan dolayı mail yana doğru çok uzuyor . Biz Sadece K ve L sütunlarını alabilir miyiz ve bu yazı "IT ile ilgili yeni oluşturulan iş emrini ekte görebilirsiniz. İyi Çalışmalar" yazısının altına gelbilir mi.
Saygılarımla[img][/img]
|