Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Макрос автоматической печати jpg
 
Есть файл jpg, а на листе гиперссылка на этот файл. Подскажите пожалуйста кто знает макрос с привязкой к кнопке на запуск печати данного файла без лишних телодвижений.
 
вот такой макрос получится:

Код
Private Declare Function apiShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
                                         ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
                                         ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub МакросПечати()
    On Error Resume Next
    ' допустим, ссылка в ячейке A1 находится
    Filename$ = Range("a1").Hyperlinks(1).Address
    If Filename$ = "" Then MsgBox "Нет ссылки в ячейке", vbCritical: Exit Sub

    ' если ссылка относительная - надо еще путь к папке дописать.
    ' это уже сами доделаете в коде

    ' вызов команды печати файла
    Call apiShellExecute(Application.hwnd, "print", Filename$, vbNullString, vbNullString, 0)
End Sub
 
http://www.planetaexcel.ru/forum/?PAGE_NAME=read&FID=8&TID=10144
Код
With Worksheets.Add   
       Set Картинка = .Pictures.Insert(ПутьКФайлу)   
       With .PageSetup   
           .Zoom = False: .FitToPagesWide = 1: .FitToPagesTall = 1   
           .Orientation = IIf(Картинка.Height >= Картинка.Width, xlPortrait, xlLandscape)   
       End With   
       .PrintPreview   
       ' если такой вариант устроит, замените .PrintPreview на .PrintOut   
   End With   
End Sub   
 
Игорь, в ячейке А1 c:\Users\User\Downloads\1111.jpg выдает сообщение "Нет ссылки в ячейке". Что делаю не то?
 
Цитата
Dobepman написал:
"Нет ссылки в ячейке". Что делаю не то?
Не внимательно читаете сообщение об ошибке. В ячейке А1 у вас нет
Цитата
Dobepman написал:
а на листе гиперссылка на этот файл
 
Подскажите пожалуйста что я делаю не так?
 
замените строку
Код
Filename$ = Range("a1").Hyperlinks(1).Address

на строку
Код
Filename$ = Range("a1").Text
 
Класс. Работает. Спасибо.  
 
Игорь, Как исправить подскажите пожалуйста.
 
Замените строку
Код
Private Declare Function apiShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
                                         ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
                                         ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


на следующий код:
Код
#If VBA7 Then
    Private Declare PtrSafe Function apiShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
            ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _
            ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
#Else
    Private Declare Function apiShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
                                          ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
                                          ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If
 
Спасибо. Подскажите пожалуйста как добавить сообщение которое будет появляется когда не существует папка.
 
Например
Код
    '...
    If Filename$ = "" Then MsgBox "Нет ссылки в ячейке", vbCritical: Exit Sub
    'Когда нет папки
    If Dir(Left(Filename$, InStrRev(Filename$, "\", -1, 1) - 1), vbDirectory) = "" Then MsgBox "Нет папки", vbCritical: Exit Sub
    '...
 
ocet p,работает, спасибо за помощь
Страницы: 1
Читают тему (гостей: 1)
Наверх