Excel Kitaplar Arası Geçişte Problem

1 2 3 4
11/05/2019, 01:21

ertus35

Ekledim dosyayı.
11/05/2019, 02:09

berduş

benim gönderdiğim dosyada "modül3" vardı, "rangetohtml()" fonksiyonu orada tanımlıydı. "Modul3" silinmiş
ama  eğer tek hücre ekleyecekseniz yani sadece "K" yı o zaman modüle falan gerek yok doğrudan 
kodu aşağıdaki gibi yapın
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
Dim rng As Range
Set rng = Nothing

i = ActiveCell.Row '<======== i= seçtiğimiz satırı gösterir satırdaki herhangi bir hücreye basılabilir
       
With Application
   .ScreenUpdating = False
   .EnableEvents = False
End With


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


   On Error Resume Next
   With OutMail
       .to = ""
       .CC = ""
       .BCC = ""
       .Subject = "IT WORK ORDER"
               .Body = "Sayın İlgililer:" & vbNewLine & _
                   "IT Departmanı ile ilgili yeni oluşturulan iş emrini aşağıda görebilirsiniz." & _
                    vbNewLine & "İyi Çalışmalar" & vbNewLine & vbNewLine & _
                    Range("K" & i).Value
       '.Attachments.Add Destwb.FullName
       '.Send
       .Display
   End With
   On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

With Application
   .ScreenUpdating = True
   .EnableEvents = True
End With
End Sub
11/05/2019, 02:36

ertus35

(11/05/2019, 02:16)haliliyas yazdı: ama  eğer tek hücre ekleyecekseniz yani sadece "K" yı o zaman modüle falan gerek yok doğrudan 
kodu aşağıdaki gibi yapın
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
Dim rng As Range
Set rng = Nothing

i = ActiveCell.Row '<======== i= seçtiğimiz satırı gösterir satırdaki herhangi bir hücreye basılabilir
       
With Application
   .ScreenUpdating = False
   .EnableEvents = False
End With


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


   On Error Resume Next
   With OutMail
       .to = ""
       .CC = ""
       .BCC = ""
       .Subject = "IT WORK ORDER"
               .Body = "Sayın İlgililer:" & vbNewLine & _
                   "IT Departmanı ile ilgili yeni oluşturulan iş emrini aşağıda görebilirsiniz." & _
                    vbNewLine & "İyi Çalışmalar" & vbNewLine & vbNewLine & _
                    Range("K" & i).Value
       '.Attachments.Add Destwb.FullName
       '.Send
       .Display
   End With
   On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

With Application
   .ScreenUpdating = True
   .EnableEvents = True
End With
End Sub

Tamam Hocam sehven silmişim Modül 3 ü. Ama dediğiniz gibi sadece K'yı ekleyeceğim. En son gönderdiğiniz kodlamayı kullandım. Çalıştı.

Emeğinize sağlık. Teşekkür ederim.

Saygılarımla
1 2 3 4