Собственно, такая проблемка... Может кто сталкивался? по ключу #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 Забыл добавить, что первоначально пытался открыть с помощью гиперссылки, но там (похоже) полное игнорирование любого текста, размещённого после символа #
У меня не ридер. А отношение непосредственное вроде как) Запрос на открытие странички я делаю из экселя.
Нашёл вариант через костыль с 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 написал: А отношение непосредственное вроде как)
Если вы добьетесь работоспособности с командной строки, и это не будет срабатывать через Shell, вот тогда это станет вопросом VBA и косвенно Excel, а сейчас это так, вопос из общих знаний..
БМВ написал: ну и открывайте Chrome через Shell и кормите сразу ссылку.
Chrome стоит у единичного количества пользователей. Т.е. не есть выход из ситуации.
Цитата
БМВ написал: Если вы добьетесь работоспособности с командной строки, и это не будет срабатывать через Shell, вот тогда это станет вопросом VBA и косвенно Excel, а сейчас это так, вопос из общих знаний..
БМВ написал: А полноценный акробат у всех? А Adobe об этом знает? Ладно опустим.
У нас в компании весь софт официальный. У меня пока пробный период. Если получится запустить этот макрос - экономия времени будет явно выше 17 евро в месяц, которые хотят за лицензию на DC Acrobat
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