Страницы: 1
RSS
Написать в ячейке адрес, где находится файл
 
Друзья, добрый вечер.

Как можно в файле написать в ячейке адрес где находится файл ( оригинал )
 
Homavi, гиперссылки. Погуглите.
 
А теперь по-русски. Какой файл-оригинал? Может так
Код
=ЯЧЕЙКА("имяфайла")
Согласие есть продукт при полном непротивлении сторон
 
Sanja, есть файл, который после вычеслений формирует письмо
и надо в тело письмо запихнуть ссылку на данный файл ( где он находится )
 
Код
ThisWorkbook.FullName
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Homavi написал:
который после вычеслений формирует письмо
как формирует?
формула именно для полного пути файла такая
=SUBSTITUTE(LEFT(CELL("filename");FIND("]";CELL("filename"))-1);"[";"")
, при этом по опыту "filename" в любой локализации, а вот "имяфайла" только в русской.
Изменено: БМВ - 24.03.2018 09:01:38
По вопросам из тем форума, личку не читаю.
 
А вообще, если отталкиваться от написанного:
Цитата
Homavi написал:
написать в ячейке адрес где находится файл
то с клавиатуры и набрать в ячейке этот "адрес"))
Homavi, не написать, а получить.
 
Off
Цитата
Юрий М написал:
то с клавиатуры
Сейчас век автоматизации. Просто что-то опущено :-)
Как можно в файле АВТОМАТИЧЕСКИ написать в ячейке адрес где находится файл ( оригинал )
По вопросам из тем форума, личку не читаю.
 

БМВ,

Код
Sub Send_Mail()
    Dim oOutlApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sTblBody As String, sAttachment As String
    Dim rDataR As Range
    Dim IsOultOpen As Boolean
 
    Application.ScreenUpdating = False
    'Пробуем подключиться к Outlook
    On Error Resume Next
    Set oOutlApp = GetObject(, "Outlook.Application")
    If Err = 0 Then
        IsOultOpen = True
    Else
        Err.clear
        Set oOutlApp = CreateObject("Outlook.Application")
    End If
    oOutlApp.Session.Logon
    Set objMail = oOutlApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set oOutlApp = Nothing: Set objMail = Nothing: Exit Sub
    
    With ActiveWorkbook.Sheets("test")
        sTo = ""
        sSubject = Sheets("1").Range("m2").Value
        sBody = .Range("B5").Value
        sAttachment = .Range("B14").Value
        'Переносы строк и шрифт
        sBody = Replace(sBody, Chr(10), "<br />")
        sBody = Replace(sBody, vbNewLine, "<br />")
        sBody = "<span style=""font-size: 14px; font-family: Century Gothic"">" & sBody & "</span>"
        'Таблица
        'важно добавлять таблицу после оформления переносов строк и шрифта
        'в противном случае форматирование таблицы может "поплыть"
        Set rDataR = .Range("B17:D29") 'Selection - если надо отправить только выделенные диапазона
        sTblBody = ConvertRngToHTM(rDataR)
        'подменяем метку {TABLE} в тексте письма реальной таблицей(сформированной выше)
        sBody = Replace(sBody, "{TABLE}", sTblBody)
    End With
        
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
'        .CC = "" 'адрес для копии
'        .BCC = "" 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .BodyFormat = 2  'olFormatHTML - формат HTML
'        .Body = RangeToTextTable(Selection) 'вставляем таблицу без форматирования
        .HTMLBody = sBody
        If sAttachment <> "" Then
            .Attachments.Add sAttachment
        End If
        .display 'если необходимо просмотреть сообщение, а не отправлять без просмотра
        '.Send 'если необходимо отправить сообщение без просмотра
    End With    
    If IsOultOpen = False Then oOutlApp.Quit
    Set oOutlApp = Nothing: Set objMail = Nothing
    DoEvents
         Application.ScreenUpdating = True
          
         
End SubFunction ConvertRngToHTM(rng As Range)
    Dim fso As Object, ts As Object
    Dim sF As String, resHTM As String
    Dim wbTmp As Workbook
 
    sF = Environ("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    'переносим указанный диапазон в новую книгу
    rng.Copy
    Set wbTmp = Workbooks.Add(1)
    With wbTmp.Sheets(1)
        'вставляем только ширину столбцов, значения и форматы
        .Cells(1).PasteSpecial xlPasteColumnWidths
        .Cells(1).PasteSpecial xlPasteValues
        .Cells(1).PasteSpecial xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
        'удаляем все объекты(фигуры, рисунки и пр.)
        '------------------------------------------
        'если рисунки и объекты нужны - удалить этот блок
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
        '------------------------------------------
    End With
    'сохраняем книгу как Веб-страницу(чтобы содержимое конвертировать в HTML-код)
    With wbTmp.PublishObjects.Add( _
         SourceType:=xlSourceRange, Filename:=sF, _
         Sheet:=wbTmp.Sheets(1).Name, Source:=wbTmp.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    'открываем созданный файл как текстовый и считываем содержимое
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sF).OpenAsTextStream(1, -2)
    resHTM = ts.ReadAll
    ts.Close
    'выравниваем таблицу по левому краю(если надо оставить по центру - удалить эту строку)
    ConvertRngToHTM = Replace(resHTM, "align=center x:publishsource=", "align=left x:publishsource=")
    'закрываем временную книгу и удаляем
    wbTmp.Close False
    Kill sF
    'очищаем объектные переменные
    Set ts = Nothing: Set fso = Nothing
    Set wbTmp = Nothing
End Function

вот код который формирует письмо и вставляет туда таблицу из листа

но как еще прописать прямую ссылку на этот документ

Изменено: Homavi - 24.03.2018 09:38:53
 
достаточно было написать что из VBA. Так надо то что, чтоб ячейка содержала ссылку на сам файл?
По вопросам из тем форума, личку не читаю.
 
БМВ,
да чтобы в ячееке хранилась ссылка на файл где он лежит на самом деле.
а уже с помощью макроса который написан он будет копировать ссылку или ячейку

на данный момент с помощью макроса который написан сверху он копирует ячейку с ссылкой ( я просто прописал ссылку ) но ссылка в письме не кликабельная (((
 
Код
Sub Send_Mail()
Dim sF As String
sF = Environ("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
' выбрать нужное
sAttachment = sF
.Range("B14").Value = sF
...............................
End Sub
Function ConvertRngToHTM(rng As Range, sF As String)
    Dim fso As Object, ts As Object
    'Dim [S]sF As String[/S] 'удалить
    Dim resHTM As String
    Dim wbTmp As Workbook
  
    '[S]sF = Environ("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"[/S] 'удалить
...........
End Function 
Изменено: RAN - 24.03.2018 10:10:08
 
так надо в sBody ставлять не просто текст а HTML тег
<a href="c:\temp]temp.xls">Temp.xls</a>
По вопросам из тем форума, личку не читаю.
 
RAN, БМВ,  что то я уже запулатся куда и что изменять (((
 
Цитата
Homavi написал:
в ячееке хранилась ссылка на файл где он лежит на самом деле
запишите вставку в нужную ячейку гиперссылки на нужный файл. Добавьте этот код в тело макроса отправки до строки:
Код
'Переносы строк и шрифт
после этого формируйте HTML код таблицы, используя диапазон, который так же содержит и эту ячейку. Гиперссылка автоматом будет преобразована в надлежащий для HTML вид.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Страницы: 1
Наверх