Страницы: 1
RSS
Формат числа в макросе для отправки почты из Excel, Положение подтягивающегося числа и его формат
 
Здравствуйте, уважаемые знатоки Excel.
Просьба помочь доделать макрос, который отправляет почту с помощью Outlook из файла Excel во вложении.
Собственно сам макрос:


Код
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub SendMailTest()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim cell As Range
     
     
    Set OutApp = CreateObject("Outlook.Application"
    Set OutMail = OutApp.CreateItem(0)
        strbody = "<font face=""Modern h medium"" size=""2"" color=""black"">" & "Уважаемые коллеги!<br>" & _
              "<B>Первая цифра:</B><br>" & Range("I145".Value & _
           "Отчет на: Здесь надо поставить текущую дату<br>" & _
              "- Инструкция находится здесь <br>" & _
              "<U><B></B></U><br>" & _
               "С уважением,"
        On Error Resume Next
    With OutMail
     .Display
        .To = Range("E2".Value
        .Subject = Range("F2".Value
       .HTMLBody = strbody & .HTMLBody
        .Attachments.Add Range("H2".Value
        .Attachments.Add Range("I2".Value
        .Attachments.Add Range("J2".Value
        .Display
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
 
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub
Как хотелось бы чтобы выглядело, и как выглядит на самом деле - прикладываю скриншоты.
Как выглядит сейчас:

Как хотелось бы:

Вопросы следующие:
1) как сделать желаемое форматирование и чтобы цифра отображалась на нужной строке в нужном положении, а не сливалась со следующей строкой?
2) Что прописать, чтобы цеплял текущую дату?
3) Если возможно, нужна еще вторая строчка в тексте письма, на которой будет написано следующее: "Вторая цифра: *тянет значение со скрытого листа 2,
ячейка Е126*", Ситуация заключается в том, что на листе 2 периодически разное кол-во строк, и нужна крайняя нижняя по столбцу Е.
 
вместо
Код
1
"<B>Первая цифра:</B><br>" & Range("I145".Value & _        "Отчет на: Здесь надо поставить текущую дату<br>
попробуйте
Код
1
"<B>Первая цифра:</B><br>" & format(Range("I145").Value,"# ###") & " руб <br>" & "Отчет на: Здесь надо поставить текущую дату<br>


обратите внимание на это:
Код
1
format(Range("I145").Value,"# ###") & " руб <br>"
форматирование числа + перевод строки после него
 
ну и вместо
Код
1
"Отчет на: Здесь надо поставить текущую дату<br>"
напишите

Код
1
"Отчет на: " & format(now, "DD.MM.YYYY")& "<br>"

формат даты можно сделать любой - в том числе месяц прописью на русском

PS: предыдущее сообщение продолжить не мог, - в очередной раз в поле ввода сообщения перестала работать клавиша Enter
 
Цитата
Игорь пишет:
Игорь, благодарю!
По первым двум вопросам все получилось (понял, что строка переносилась из-за лишнего <br> ;)
Насчет третьего вопроса: как заставить Excel брать самое нижнее значение из столбца E со второго скрытого листа?
Т. е. должно быть что-то такое:
"Вторая цифра: " & Format(САМОЕ НИЖНЕЕ ЗНАЧЕНИЕ ПО СТОЛБЦУ Е С ЛИСТА 2).Value, "# ### ###" ;)  & " ðóá. <br>" & _
 
В начале макроса (после всех Dim) добавить строку
Код
1
    lRow = Cells(Rows.Count, 5).End(xlUp).Row
а в переменную strbody = добавить что-то вроде этого
Код
1
Вторая цифра:</B><br>" & Format(Range("I" & lRow).Value, "# ### ###")
не проверял
Изменено: Sanja - 27.06.2014 14:27:43
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja пишет: не проверял
Проверил, выдает 400 ошибку Visial Basic
 
Приложите файл с исправленным макросом
Согласие есть продукт при полном непротивлении сторон
 
Вот
 
lomobodo, а без цитирования никак? Ну вот ЗАЧЕМ оно здесь?!!
 
.
Согласие есть продукт при полном непротивлении сторон
 
Юрий М, можно и без цитирования, больше не буду злоупотреблять :)

Sanja, спасибо! а можно еще допилить, чтобы он не с текущего листа по столбцу искал последнее значение, а с листа 2 (скрытый в оригинальном файле, но подозреваю, что для Visual Basic главное название листа, а не то, что он скрыт)
 
можно так (если это действительно ВТОРОЙ лист)
Код
1
2
3
4
5
.............................................
lRow = Лист2.Cells(Rows.Count, 5).End(xlUp).Row
    ........................................
"<B>Вторая цифра: </B>" & Format(Лист2.Range("I" & lRow).Value, "# ### ###") & " руб. <br>" & _
............................................
или так (если Лист 2 это имя листа)

Код
1
2
3
4
5
..................................................    
lRow = Sheets("Лист 2").Cells(Rows.Count, 5).End(xlUp).Row
   ................................................
"<B>Вторая цифра: </B>" & Format(Sheets("Лист 2").Range("I" & lRow).Value, "# ### ###") & " руб. <br>" & _
.................................................
Изменено: Sanja - 30.06.2014 13:53:33
Согласие есть продукт при полном непротивлении сторон
 
Sanja,
Спасибо, все работает!
На всякий случай вставляю код целиком, если кому-то понадобится решать такую же задачу - отправлять письма из Эксель, беря различные значения с разных листов.
Макрос формирует письмо, вставляет в письмо значение ячейки I145 с листа, на котором запущен + последнее значение по столбцу Е с листа с названием "2" + вставляет текущую дату.
Для тех, кто делает регулярную рассылку писем на основании каких-либо отчетов будет полезен.
Спасибо знатокам с форума
Код
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub SendMailTest()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim cell As Range
    lRow = Sheets("2".Cells(Rows.Count, 5).End(xlUp).Row
     
     
    Set OutApp = CreateObject("Outlook.Application"
    Set OutMail = OutApp.CreateItem(0)
        strbody = "<font face=""Modern h medium"" size=""2"" color=""black"">" & "Уважаемые коллеги<br>" & _
              "<B>Первая цифра: </B>" & Format(Range("I145".Value, "# ### ###" & " руб. <br>" & _
             "<B>Вторая цифра: </B>" & Format(Sheets("2".Range("E" & lRow).Value, "# ### ###" & " руб. <br>" & _
           "Отчет на: " & Format(Now, "DD.MM.YYYY" & "<br>" & _
              "- Инструкцию найдете тут <br>" & _
              "<U><B></B></U><br>" & _
               "С уважением,"
        On Error Resume Next
    With OutMail
     .Display
        .To = Range("E2".Value
        .Subject = Range("F2".Value
       .HTMLBody = strbody & .HTMLBody
        .Attachments.Add Range("H2".Value
        .Attachments.Add Range("I2".Value
        .Attachments.Add Range("J2".Value
        .Display
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
 
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End S
 
Как так коряво удалось код закопипастить? Попробуйте переделать - больше половины строк с ошибками.
 
думаю человек смайлики поудалял а скобки не расставил
Согласие есть продукт при полном непротивлении сторон
 
Странно, смайлики в ручную не удалял, просто вставил как код. Попытка №2
Код
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub SendMailTest()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim cell As Range
    
    lRow = Sheets("2").Cells(Rows.Count, 5).End(xlUp).Row    
     
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
        strbody = "<font face=""Modern h medium"" size=""2"" color=""black"">" & "English see below!<br>" & _
        "       <br>" & _
        "ТЕКСТ ПИСЬМА<br>" & _
       "       <br>" & _
              "<font face=""Modern h medium"" size=""2"" color=""red"">" & "ЦИФРА КОТОРАЯ ПОДТЯГИВАЕТСЯ С ЯЧЕЙКИ I145: " & Format(Range("I145").Value, "# ### ###") & " руб. <br>" & _
             "ЦИФРА, КОТОРАЯ ПОДТЯГИВАЕТСЯ С ЛИСТА 2: " & Format(Sheets("2").Range("C" & lRow).Value, "# ### ###") & " ðóá. <br>" & _
             "ЦИФРА, КОТОРАЯ ПОДТЯГИВАЕТСЯ С ЛИСТА 2: " & Format(Sheets("2").Range("E" & lRow).Value, "# ### ###") & " %. <br>" & _
             "       <br>" & _
           "<font face=""Modern h medium"" size=""2"" color=""black"">" & "ТЕКУЩАЯ ДАТА " & Format(Now, "DD.MM.YYYY") & " ïî: " & "<br>" & _
"ТЕКСТ ПИСЬМА<br>" & _
"ТЕКСТ ПИСЬМА<br>" & _
"ТЕКСТ ПИСЬМА<br>" & _
"       <br>" & _
"ТЕКСТ ПИСЬМА И СНОВА ЦИФРА С ЯЧЕЙКИ I145: " & "<font face=""Modern h medium"" size=""2"" color=""red"">" & Format(Range("H145").Value, "# ### ###") & " руб. <br>" & _
"       <br>" & _
"<font face=""Modern h medium"" size=""2"" color=""black"">" & "ТЕКСТ ПИСЬМА<br>" & _
"       <br>" & _
"ТЕКСТ ПИСЬМА<br>" & _
"СЮДА БЫ ВСТАВИТЬ ГИПЕРССЫЛКУ<br>" & _
              "С УВАЖЕНИЕМ, <br>" & _
              "       <br>" & _
                   "ТЕКСТ ПИСЬМА<br>" & _
               "ТЕКСТ ПИСЬМА"
        On Error Resume Next
    With OutMail
     .Display
        .To = Range("E2").Value
        .Subject = Range("F2").Value
       .HTMLBody = strbody & .HTMLBody
        .Attachments.Add Range("H2").Value
        .Attachments.Add Range("I2").Value
        .Attachments.Add Range("J2").Value
        .Display
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
 
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub
Подскажите еще, пожалуйста, как можно обойти ограничение "too many line continuations", которое появляется (как подсказывает гугл) после добавления & _ более 24 раз. Т. е. задача составить длинное письмо, в котором необходимы переходы со строки на строку.
И есть ли возможность вставить в текст письма гиперссылку (которая без макроса вставляется с помощью "Вставка >>>> Гиперссылка". Пробовал посмотреть необходимый код с помощью записи макроса, но не получается вставить его в тело письма:

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
       "C:\Programm Files\1.xlsx", TextToDisplay:= _
       "C:\Programm Files\1.xlsx"
 
& _ никак не влияет на сам текст письма. Это относится только к коду.
 
Hugo,
Точно, спасибо большое, это вообще лишние куски кода тут.
Остался только открытый вопрос с гиперссылкой...
Страницы: 1
Читают тему
Наверх
Loading...