xlsm olarak kaydetme

[kneehot]

arkadaslar merhaba. daha onceden kullandıgım bır makroyu yenı bır dosyaya uygulamaya calısıyorum fakat dosyayı xls formatında kaydetmek uzere yazılmıs o yuzden uyarı verıyor. makroyu xlsm formatında kaydedecek sekılde ayarlamaya calıstım fakat beceremedım. yardımlarınızı beklıyorum ve sımdıden cok tesekkur edıyorum.


Sub mail()
Sheets("SİPARİŞ LİSTESİ").Select
'MsgBox "MAIL GÖNDERİLİYOR.!!" & Chr(10) & Chr(10) & "LÜTFEN MAIL GÖNDERİLDİ" & Chr(10) & Chr(10) & "BİLGİSİNİ ALANA KADAR BEKLEYİNİZ.!!!", vbOKOnly
'You must add a reference to the Microsoft outlook Library
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim wb As Workbook
Dim i As Integer
' Dim strdate As String
' strdate = Format(Now, "dd-mm-yy h-mm-ss")
Application.ScreenUpdating = False
For i = 2 To 2
ActiveSheet.Copy
Set wb = ActiveWorkbook

With wb
.SaveAs [b1] & " " & "BÖLGE" & " " & ActiveSheet.Name & ".xls" '"Part of " & ThisWorkbook.Name _
& " " & strdate & ".xls", xlExcel8
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = Cells(i, "k")
.CC = ""
.BCC = ""
.Subject = [b1] & " " & "BÖLGE" & " " & [i5] & " SON TARİHLİ KARŞILAŞTIRMA RAPORU"
.Body = " BU MAIL " & " " & Now & " " & "TARİHİNDE GÖNDERİLMİŞTİR."
.Attachments.Add wb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display

End With
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False

End With
Next
MsgBox "MAIL GÖNDERİLDİ.!!", vbOKOnly
Application.ScreenUpdating = True
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

 

[Emir Hüseyin Çoban]

. . .

Kırmızı ile belirttiğim satırları ilave ederek deneyiniz.

Dim wb As Workbook
Dim i As Integer
[COLOR="Green"]' Dim strdate As String
' strdate = Format(Now, "dd-mm-yy h-mm-ss")[/COLOR]
Application.ScreenUpdating = False
[COLOR="Red"]Application.DisplayAlerts = False[/COLOR]
For i = 2 To 2

[B]'kodlarınız...[/B]
MsgBox "MAIL GÖNDERİLDİ.!!", vbOKOnly
Application.ScreenUpdating = True
[COLOR="red"]Application.DisplayAlerts = True[/COLOR]
Set OutMail = Nothing
Set OutApp = Nothing

. . .

 

[kneehot]

. . .

Kırmızı ile belirttiğim satırları ilave ederek deneyiniz.

Dim wb As Workbook
Dim i As Integer
[COLOR="Green"]' Dim strdate As String
' strdate = Format(Now, "dd-mm-yy h-mm-ss")[/COLOR]
Application.ScreenUpdating = False
[COLOR="Red"]Application.DisplayAlerts = False[/COLOR]
For i = 2 To 2

[B]'kodlarınız...[/B]
MsgBox "MAIL GÖNDERİLDİ.!!", vbOKOnly
Application.ScreenUpdating = True
[COLOR="red"]Application.DisplayAlerts = True[/COLOR]
Set OutMail = Nothing
Set OutApp = Nothing

. . .

yardımınız ıcın cok tesekkur ederım fakat bu ekleme ıle sadece uyarıyı kaldırmıs olduk dosya yıne xls olarak gonderılıyor. bunu xlsm olarak gonderme sansımız yokmudur.

 

[Emir Hüseyin Çoban]

. . .

.SaveAs [b1] & " " & "BÖLGE" & " " & ActiveSheet.Name & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled

. . .

 

[kneehot]

. . .

.SaveAs [b1] & " " & "BÖLGE" & " " & ActiveSheet.Name & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled

. . .

cok tesekkur ederım.