Суббота, 01 сентября 2018
  0 Ответы
  2.6 тыс. Посещений
Я установил kutools, чтобы помочь с проектом для работы. Я также управляю отчетом большой компании, в котором есть макрос, создающий электронное письмо из введенной информации. Этот макрос перестал работать на моем компьютере. Он работает на компьютерах, на которых нет kutools. Кто-нибудь сталкивался с чем-то подобным раньше? Вот макрос, который отлично работает на других компьютерах:

Sub Mail_Sheet_Outlook_Body ()
'Работа в Excel 2000-2016
Приложение.ReferenceStyle = xlA1
Уменьшить диапазон как диапазон
Dim OutApp как объект
Затемнить OutMail как объект
Dim xFolder как строка
Dim xSht как рабочий лист
Dim xSub как строка
Тусклый ответ как строка
Уменьшить сообщение как строку
Тусклый стиль как строка
Тусклый заголовок как строка

Установите xSht = ActiveSheet
Msg = "Вы уверены, что хотите отправить эту форму по электронной почте?" 'Определить сообщение.
Style = vbYesNo + vbCritical + vbDefaultButton2 'Определить кнопки.
Title = "Подтверждение отправки по электронной почте" ' Определить заголовок.
Ответ = MsgBox(Сообщение, Стиль)

Если Ответ = vbДа Тогда
xFolder = Environ("USERPROFILE") + "\Desktop\" + "\Field Audit Form--" + CStr(xSht.Cells(19, "A").Value) + "--.pdf"
'xSub = "Аудит полей для магазина" + CStr(xSht.Cells(19, "A").Value)
С применением
.EnableEvents = False
.ScreenUpdating = False
Конец с

Установить rng = Ничего
Установить rng = ActiveSheet.UsedRange
'Вы также можете использовать имя листа
'Set rng = Sheets("YourSheet").UsedRange

Установите OutApp = CreateObject("Outlook.Application")
Установить OutMail = OutApp.CreateItem(0)
Dim varCellvalue как долго




On Error Resume Next
С OutMail
.К = ""
.CC = ""
.BCC = ""
.Subject = "Подведение итогов"
.Attachments.Добавить xFolder
.HTMLBody = RangetoHTML(rng)
.Display или использовать .Display

Конец с
По ошибке GoTo 0

С применением
.EnableEvents = True
.ScreenUpdating = True
Конец с

Установите OutMail = Ничего
Установить OutApp = Ничего
End If
End Sub


Функция RangetoHTML (rng As Range)
«Работа в офисе 2000-2016 г.
Dim fso как объект
Размеры как объект
Dim TempFile как строка
Dim TempWB как рабочая книга

TempFile = Environ$("temp") & "\" & Format(Теперь "дд-мм-гг ч-мм-сс") & ".htm"

'Скопируйте диапазон и создайте новую книгу, чтобы вставить данные в
rng.Копировать
Установите TempWB = Workbooks.Add(1)
С TempWB.Sheets(1)
.Cells(1).PasteSpecial Вставить:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Ячейки(1).Выбрать
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = Истина
.DrawingObjects.Delete
По ошибке GoTo 0
Конец с

'Публикация листа в файле htm
С помощью TempWB.PublishObjects.Add( _
Тип источника: = xlSourceRange, _
Имя файла:=Временный файл, _
Лист:=TempWB.Sheets(1).Имя, _
Источник: = TempWB.Sheets(1).UsedRange.Address, _
Хтмлтипе:=xlHtmlStatic)
.Опубликовать (правда)
Конец с

'Читать все данные из файла htm в RangetoHTML
Установите fso = CreateObject ("Scripting.FileSystemObject")
Установите ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ц.Закрыть
RangetoHTML = Заменить(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

'Закрыть TempWB
TempWB.Закрыть изменения:=False

'Удалите файл htm, который мы использовали в этой функции
Убить временный файл
Установить тс = Ничего
Установите fso = Ничего
Установите TempWB = Ничего

End Function
Там нет ответов, сделанные на этот пост пока нет.