[blackeangel]

вот код из vba

Код:

Sub viewe() 'просмотр из любой ячейки книги
On Error Resume Next
Dim n As String, m As String, m1 As String, v As String
Dim z As Range, a As Range
Dim s, w
m = ActiveCell
'm = Cells(ActiveCell.Row, ActiveCell.Column)
    If m = "" Then
        MsgBox "В ячейке пусто!", vbExclamation
        Exit Sub
    End If
'если документа с исполнением нет в БД искать(базовый документ) без исполнения
'==>
If InStr(1, m, "-") > 0 Then
    m = Left(m, InStr(1, m, "-") - 1)
End If
'<==
'=====================================================================================================
n = "N:\_7_Все_карточки\Карточки.xlsm"
Set s = GetObject(n)
m1 = m + "СБ"
Set z = s.Worksheets(1).Cells.Find(What:=m1, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows)
If z Is Nothing Then
Set z = s.Worksheets(1).Cells.Find(What:=m, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows)
End If
If z Is Nothing Then
    n = "N:\_7_Все_карточки\Предварительный архив.xlsm"
    Set s = GetObject(n)
        Set z = s.Worksheets(1).Cells.Find(What:=m1, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows)
'        MsgBox "z= " & z
          If z Is Nothing Then
              Set z = s.Worksheets(1).Cells.Find(What:=m, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows)
           End If
End If
If z = "" Then
       MsgBox "Номер нигде не найден!", vbExclamation
       Exit Sub
End If

ipage = 30
arrStr = Split(s.Worksheets(1).Cells(z.Row, ipage), "!")
x = 0
x = Shell("C:\Program Files (x86)\IrfanView\i_view32.exe " & "n:\_8_Все_tif\" & arrStr(0), vbNormalFocus)
x = Shell("c:\Program Files\IrfanView\i_view32.exe " & "n:\_8_Все_tif\" & arrStr(0), vbNormalFocus)
If x > 0 Then Exit Sub  'Если IrfanView не установлен, открываем XnView
x = Shell("C:\Program Files (x86)\XnView\xnview.exe " & "n:\_8_Все_tif\" & arrStr(0))
x = Shell("c:\Program Files\XnView\xnview.exe " & "n:\_8_Все_tif\" & arrStr(0))
's.Close SaveChanges:=False

End Sub
Sub viewe_NP()
ipage = 29 + Val(InputBox("Введите номер страницы"))
open_file_in_XN
End Sub