By Konuk 01 Eylül 2018 Cumartesi günü
Yayınlanan Kutools for Excel
Cevaplar 0
Seviyor 0
Görünümler 2.7K
Oy 0
İş için bir projeye yardımcı olmak için kutools kurdum. Ayrıca girilen bilgilerden bir e-posta oluşturan bir makroya sahip büyük bir şirket raporunu yönetiyorum. Bu makro bilgisayarımda çalışmayı durdurdu. Kutools olmayan bilgisayarlarda çalışır. Daha önce böyle bir şeyle karşılaşan var mı? İşte diğer bilgisayarlarda gayet iyi çalışan makro:

Alt Mail_Sheet_Outlook_Body()
'Excel 2000-2016'da Çalışmak
Application.ReferenceStyle = xlA1
Aralık Olarak Karartma
OutApp'i Nesne Olarak Karart
OutMail'i Nesne Olarak Karartın
Dize olarak xFolder'ı karart
Dim xSht As Çalışma Sayfası
Dize Olarak Dim xSub
Dize Olarak Karartma Yanıtı
Mesajı Dize Olarak Karart
Dize Olarak Dim Stili
Dize Olarak Başlığı Karart

xSht = ActiveSheet'i ayarla
Msg = "Bu formu e-posta ile göndermek istediğinizden emin misiniz?" ' Mesajı tanımla.
Stil = vbYesNo + vbCritical + vbDefaultButton2 ' Düğmeleri tanımlayın.
Başlık = "E-posta gönderme onayı" ' Başlığı tanımlayın.
Yanıt = MsgBox(Mesaj, Stil)

Yanıt = vbYes ise
xFolder = Environ("KULLANICI PROFİLİ") + "\Masaüstü\" + "\Alan Denetim Formu--" + CStr(xSht.Cells(19, "A").Value) + "--.pdf"
'xSub = "Mağaza için Alan Denetimi " + CStr(xSht.Cells(19, "A").Value)
Uygulama ile
.EnableEvents = Yanlış
.ScreenUpdating = Yanlış
İle bitmek

Rng ayarla = Hiçbir şey
rng'yi ayarla = ActiveSheet.UsedRange
'Bir sayfa adı da kullanabilirsiniz
'Set rng = Sayfalar("Sayfanız").UsedRange

Set OutApp = CreateObject("Outlook.Application")
OutMail'i Ayarla = OutApp.CreateItem(0)
Dim varCellvalue As Long




On Error Resume Next
OutMail ile
.To = ""
.CC = ""
.BCC = ""
.Subject = "Özet"
.Ekler.xFolder Ekle
.HTMLBody = HTML'ye Aralık(rng)
.Display 'veya kullanın .Display

İle bitmek
Hata Dönüsünde 0

Uygulama ile
.EnableEvents = True
.ScreenUpdating = Doğru
İle bitmek

OutMail'i Ayarla = Hiçbir Şey
OutApp'i Ayarla = Hiçbir Şey
Eğer son
End Sub


İşlev RangetoHTML(Rng As Range)
' Office 2000-2016'da Çalışmak
Nesne Olarak Dim fso
Nesne Olarak Karartma
Dize Olarak TempFile Dim
Çalışma Kitabı olarak Dim TempWB

TempFile = Environ$("temp") & "\" & Format(Şimdi, "gg-aa-yy s-aa-ss") & ".htm"

'Aralığı kopyalayın ve içindeki verileri geçmek için yeni bir çalışma kitabı oluşturun.
rng.Kopyala
TempWB = Çalışma Kitaplarını Ayarla.Add(1)
TempWB.Sheets ile(1)
.Hücreler(1).PasteÖzel Yapıştır:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Hücreler(1).Seç
Application.CutCopyMode = Yanlış
On Error Resume Next
.DrawingObjects.Visible = Doğru
.DrawingObjects.Sil
Hata Dönüsünde 0
İle bitmek

'Sayfayı bir htm dosyasında yayınlayın
TempWB.PublishObjects.Add ile( _
SourceType:=xlSourceRange, _
Dosya adı:=TempFile, _
Sayfa:=TempWB.Sheets(1).Name, _
Kaynak:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatik)
.Yayınla (Doğru)
İle bitmek

'HTm dosyasındaki tüm verileri RangetoHTML'ye okuyun
Fso = CreateObject ("Scripting.FileSystemObject") olarak ayarlayın
ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) olarak ayarlayın
AralıktanHTML'ye = ts.readall
ts.Kapat
RangetoHTML = Değiştir(RangetoHTML, "align=center x:publishsource=", _
"align=sol x:yayın kaynağı=")

'Kapat TempWB
TempWB.Close savechanges:=Yanlış

'Bu fonksiyonda kullandığımız htm dosyasını silin
TempFile'ı öldür
ts = Hiçbir şey ayarla
fso = Hiçbir şey olarak ayarla
TempWB'yi Ayarla = Hiçbir Şey

son İşlevi
Yazının Tamamını Görüntüle