Страницы: 1
RSS
Не срабатывает переход по ключу nameddest в pdf
 
Собственно, такая проблемка... Может кто сталкивался? по ключу #page работает идеально!
Код
Sub OpenEplan()
Dim NamedDest, pat1, pat2, pat3 As String

NamedDest = Replace_symbols(Cells(ActiveCell.Row, 18))
pat1 = GetShellFileCommand("PDF")
pat1 = Left(pat1, Len(pat1) - 4)
pat2 = "/n /A""pagemode=bookmarks&nameddest=_AB350_E011_21_0" & """"
'pat2 = "/A ""nameddest=" & NamedDest & """"
pat3 = """" & Cells(1, 1).Value & """"
Shell pat1 & " " & pat2 & " " & pat3, vbNormalFocus
Cells(1, 2) = pat1 & " " & pat2 & " " & pat3

End Sub
Function Replace_symbols(ByVal txt As String) As String
    St$ = "=./"
    For i% = 1 To Len(St$)
        txt = Replace(txt, Mid(St$, i, 1), "_")
    Next
    Replace_symbols = txt
End Function
Function GetShellFileCommand(FileType As String, Optional Command As String)
Const KEY_ROOT As String = "HKEY_CLASSES_ROOT\"
Dim sKey As String, sProgramClass As String
    ' All File Extensions should start with a "."
    If Left(FileType, 1) <> "." Then FileType = "." & FileType
    ' Check if the File Extension Key exists and Read the default string value
    sKey = KEY_ROOT & FileType & "\"
    If RegKeyExists(sKey) Then
        sProgramClass = RegKeyRead(sKey)
        sKey = KEY_ROOT & sProgramClass & "\shell\"
        If RegKeyExists(sKey) Then
            ' If no command was passed, check the "shell" default string value, for a default command
            If Command = vbNullString Then Command = RegKeyRead(sKey)
            ' If no Default command was found, default to "Open"
            If Command = vbNullString Then Command = "Open"
            ' Check for the command
            If RegKeyExists(sKey & Command & "\command\") Then GetShellFileCommand = RegKeyRead(sKey & Command & "\command\")
        End If
    End If
End Function
Function RegKeyRead(i_RegKey As String) As String
Dim myWS As Object

  On Error Resume Next
  'access Windows scripting
  Set myWS = CreateObject("WScript.Shell")
  'read key from registry
  RegKeyRead = myWS.RegRead(i_RegKey)
End Function
Function RegKeyExists(i_RegKey As String) As Boolean
Dim myWS As Object

  On Error GoTo ErrorHandler
  'access Windows scripting
  Set myWS = CreateObject("WScript.Shell")
  'try to read the registry key
  myWS.RegRead i_RegKey
  'key was found
  RegKeyExists = True
  Exit Function

ErrorHandler:
  'key was not found
  RegKeyExists = False
End Function
Function GetARE(i_RegKey As String) As String
    Dim InPath As String
    Dim InKey As String
    Dim Ind As Integer
    Dim PriVer As String
    Dim SubVer As String
    Dim Exists As Boolean

    Exists = False

    PriVer = 1
    SubVer = 0

    For Ind = 1 To 1000
        If SubVer > 9 Then
            PriVer = PriVer + 1
            SubVer = 0
        End If

        Exists = RegKeyExists(i_RegKey + "\" + PriVer + "." + SubVer + "\InstallPath\")
        SubVer = SubVer + 1

        If Exists = True Then
            SubVer = SubVer - 1
            InKey = i_RegKey + "\" + PriVer + "." + SubVer + "\InstallPath\"
            InPath = RegKeyRead(InKey)
            GetARE = InPath + "\AcroRd32.exe"
            Exit For
        End If
    Next
End Function

Заранее признателен за помощь!
PS
Забыл добавить, что первоначально пытался открыть с помощью гиперссылки, но там (похоже) полное игнорирование любого текста, размещённого после символа #  
Изменено: Zulus-007 - 06.07.2020 10:08:10
 
а разве для ридера это доступно, да и какое отношение вопрос имеет к Excel?
По вопросам из тем форума, личку не читаю.
 
У меня не ридер. А отношение непосредственное вроде как) Запрос на открытие странички я делаю из экселя.

Нашёл вариант через костыль с IE, но дело в том, что он тоже не берёт доп ключи, в то время как хром спокойно(((
Код
Sub OpenPDFpage()
    Dim myLink As String
    Dim NamedDest As String
 Dim IE As InternetExplorer

  Set IE = CreateObject("InternetExplorer.Application")

    
    NamedDest = Replace_symbols(Cells(ActiveCell.Row, 18))   'NamedDest to be shown
    myLink = "" & Cells(1, 2).Value & "" & "#nameddest=" & NamedDest & "&view=fit"
'MsgBox myLink

Cells(1, 2) = myLink
    With IE
        .Navigate myLink
        .Visible = True
    End With
End Sub

Function Replace_symbols(ByVal txt As String) As String
    St$ = "=./"
    For i% = 1 To Len(St$)
        txt = Replace(txt, Mid(St$, i, 1), "_")
    Next
    Replace_symbols = txt
End Function
Изменено: Zulus-007 - 06.07.2020 10:09:00
 
Цитата
Zulus-007 написал:
А отношение непосредственное вроде как)
Если вы добьетесь работоспособности с командной строки, и это не будет срабатывать через Shell, вот тогда это станет вопросом VBA и косвенно Excel, а сейчас это так, вопос из общих знаний..
Цитата
Zulus-007 написал:
в то время как хром спокойно
ну и открывайте Chrome  через Shell и кормите сразу ссылку.
Изменено: БМВ - 04.07.2020 13:11:29
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
ну и открывайте Chrome  через Shell и кормите сразу ссылку.
Chrome стоит у единичного количества пользователей. Т.е. не есть выход из ситуации.
Цитата
БМВ написал:
Если вы добьетесь работоспособности с командной строки, и это не будет срабатывать через Shell, вот тогда это станет вопросом VBA и косвенно Excel, а сейчас это так, вопос из общих знаний..
оно работает. Вопрос именно к экселю.
Изменено: Zulus-007 - 04.07.2020 13:15:54
 
Цитата
Zulus-007 написал:
Chrome стоит у единичного количества пользователей.
А полноценный акробат у всех? А Adobe об этом знает? Ладно опустим.

Edge, а лучше NewEdge?

ну и естественно прям вот строка результата pat1 & " " & pat2 & " " & pat3 в cmd  отрабатывает, а из Shell  нет?

C:\Program Files (x86)\Adobe\Acrobat DC\Acrobat\Acrobat.exe - я б экранировал кавычками, так как там есть пробел.
Изменено: БМВ - 04.07.2020 13:33:46
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
А полноценный акробат у всех? А Adobe об этом знает? Ладно опустим.
У нас в компании весь софт официальный. У меня пока пробный период. Если получится запустить этот макрос - экономия времени будет явно выше 17 евро в месяц, которые хотят за лицензию на DC Acrobat
Цитата
БМВ написал:
Edge, а лучше NewEdge?
Я не знаю как запустить через эти приложения.
Цитата
БМВ написал:
ну и естественно прям вот строка результата pat1 & " " & pat2 & " " & pat3 в cmd  отрабатывает, а из Shell  нет?
pdf  в акробате открывает, но на 1 странице. Попробовал в shell, ругается на доп ключи:

[img]file:///C:/Users/KODM02/Desktop/Administrator_%20Windows%20PowerShell.png[/img]
Вот текст коротый отсылаю:
start-process "C:\Program Files (x86)\Adobe\Acrobat DC\Acrobat\Acrobat.exe" /n/A "pagemode=bookmarks&nameddest=_AB350_E011_21_0" "C:\Users\KODM02\Desktop\UMTRAECHEON\E plan\NamedDest\A02545L210_301_FIELD_V3-03.pdf"

В источнике указано что команда должна выглядеть так:
Acrobat.exe /A "zoom=1000" "C:\example.pdf"
Отдаю такую же - всё равно ошибка (ругается на zoom)

Может ковычки не те, я уже всю голову сломал...
 
Zulus-007, добейтесь чтоб из командной строки запуск произошел согласно ваiим ожиданиям, а после эту строку кормите SHELL
До этого - это не вопрос Excel или VBA. Не надо мудрить и Power shell привлекать. Ограничьтесь CMD или просто Win+R и там пишите.
По вопросам из тем форума, личку не читаю.
 
По итогу вышел из ситуации следующим кодом:
Код
Sub OpenPDFpage()
Dim chromePath, NamedDest, myLink As String
chromePath = """C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"""
NamedDest = Replace_symbols(Cells(ActiveCell.Row, Cells(1, 2).Value))
myLink = "" & "file:///" & Cells(1, 1).Value & "" & "#nameddest=" & NamedDest & "&view=fit"""  
Shell (chromePath & Chr$(34) & myLink & Chr$(34))
End Sub
2 нюанса, которые возникли.
Если в пути содержатся пробелы, добавляем ещё одни наружные кАвычки с помощью Chr$(34)
И если в ссылке присутствует # ("#nameddest="), необходимо в начале адреса указать "file:///", в противном случае # преобразуется в %23
Если кто-то сможет открыть напрямую в ридере, буду рад инфе
Цитата
БМВ написал:
Zulus-007 , добейтесь чтоб из командной строки запуск произошел согласно ваiим ожиданиям, а после эту строку кормите SHELL
не осилил(((
Страницы: 1
Наверх