Добрый день.
Имеется простенький макрос:
из таблицы в экселе последовательно перебираются строки, по каждой формируется письмо: текст+ файл во вложении + таблица из файла. Таблица стандартная - шапка и значения. При объединении строк между ними образуется пробел, который не получается убрать в коде.
В чем проблема?
Имеется простенький макрос:
из таблицы в экселе последовательно перебираются строки, по каждой формируется письмо: текст+ файл во вложении + таблица из файла. Таблица стандартная - шапка и значения. При объединении строк между ними образуется пробел, который не получается убрать в коде.
В чем проблема?
Код |
---|
Sub cards_send()Application.DisplayAlerts = False Application.ScreenUpdating = False 'пер-е/конст сист Dim Mail_Object, Mail_Single As Variant Dim my_date As String, puthtm As String, n As String, my_date_papk As String, my_park_papk As String, my_date_file As String, putfile As String, my_date_send As String, SigString As String Dim book1 As Workbook Dim x As String For i = 4 To 12 puthtm = "C:\Users\Анастасия\Documents\tech\file.htm" Set Mail_Object = CreateObject("Outlook.Application") 'запускаем Outlook в скрытом режиме, если не запустился - выходим putfile = ThisWorkbook.Worksheets(3).Cells(i, 10).Value my_date = ThisWorkbook.Worksheets(3).Cells(i, 1).Value ThisWorkbook.Worksheets(3).Cells(i, 2).Interior.Color = vbYellow x = "$C$" & i & ":$I$" & i If Len(Dir(putfile)) = 0 Then MsgBox "Такого файла нет. Проверьте дату ввода; имя файла; путь файла" Application.DisplayAlerts = True Exit Sub End If Set book1 = Application.Workbooks.Open(putfile) Set Mail_Single = Mail_Object.CreateItem(0) Mail_Single.To = ThisWorkbook.Worksheets(3).Cells(i, 11).Value Mail_Single.Subject = "Премирование | Оценка эффективности деятельности за 2019 год " Mail_Single.attachments.Add (putfile) Mail_Single.CC = " <Olga@so.ru>; " 'body письма Mail_Single.display SigString = Mail_Single.HTMLbody Mail_Single.HTMLbody = "<p style='font-family:times;font-size:11pt;font color:#1f497d'> " + my_date + ", добрый день!<br>по итогам Вашей работы <b><font color='#E81510'>за 2019 год</font></b> была осуществлена оценка эффективности деятельности на основе карты целей. <br>Выплата второй части годовой премии с учетом Ваших оценок по карте целей - 27 марта 2020 г. <br><br> <u>Этапы проведения оценки: </u><br> 1. Расчет количественных показателей центрами компетенций<br>2. Согласование коэффициентов руководителем<br> <br><b><font color='#E81510'>Итоговые коэффициенты:</font></p>" _ & RangetoHTML(puthtm, "Лист4", Application.ThisWorkbook.Worksheets("Лист4").Range("c1:i3").Address, Application.ThisWorkbook) _ & RangetoHTML(puthtm, "Лист4", x, Application.ThisWorkbook) & "<p style='font-family:times;font-size:11pt;font color:#1f497d'>Во вложении итоговые формы оценки по карте целей за 2019 год. <br> Успехов и продуктивной работы! </p>" + SigString Set Mail_Single = Nothing Set Mail_Object = Nothing If Dir(puthtm) <> "" Then Kill (puthtm) 'удаляем ранее созданный временный htm End If book1.Close Next i Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub 'пер-е: путь временого файла,имя листа,область коп-я,из какой книги Function RangetoHTML(puthtm As String, n As String, t As String, actwbk As Object) 'создание html файла для вложения таблицы в тело и непосредственно само вложение With actwbk.PublishObjects.Add(SourceType:=xlSourceRange, _ Filename:=puthtm, _ Sheet:=n, _ Source:=t, _ HtmlType:=xlHtmlStatic) .Publish (True) End With Dim TempFile As String Dim TempWB As Workbook Dim fso As Object Dim ts As Object TempFile = "C:\Users\Анастасия\Documents\tech\file.htm" 'это путь куда создаётся временный htm Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.ReadAll ts.Close RangetoHTML = Replace(RangetoHTML, "align=center", "align=left") End Function |