Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Усовершенствование гиперссылки - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Усовершенствование гиперссылки (Формулы/Formulas)
Усовершенствование гиперссылки
fairylive Дата: Пятница, 29.01.2016, 18:07 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 122
Репутация: 4 ±
Замечаний: 0% ±

Excel 2016
Как известно при совместном общем доступе нельзя вставлять гиперссылку через меню. Можно через функцию Гиперссылка. Но при этом приходится делать много манипуляций (собственно прописать функцию, скопировать и вставить путь к файлу, прописать имя ссылки).
Есть код который немного упрощает данное действие. Он обрабатывает событие Двойной щелчок и запускает файл путь которого достаточно скопировать в ячейку.
Цитата Manyasha, 28.01.2016 в 11:43, в сообщении № 9
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Columns(5)) Is Nothing Then
        If Target.Value <> "" Then
            fPath = "start " & """"" " & """" & Target.Value & """"""
            Shell "cmd /c" & fPath, vbHide: Cancel = True
        End If
    End If
End Sub
[/vba]


Хотелось бы узнать можно ли усовершенстовать данный код чтобы в ячейке отображалось только имя файла без полного пути. Но при этом по двойному щелчку открывался бы сам файл.


Сообщение отредактировал fairylive - Пятница, 29.01.2016, 18:08
 
Ответить
СообщениеКак известно при совместном общем доступе нельзя вставлять гиперссылку через меню. Можно через функцию Гиперссылка. Но при этом приходится делать много манипуляций (собственно прописать функцию, скопировать и вставить путь к файлу, прописать имя ссылки).
Есть код который немного упрощает данное действие. Он обрабатывает событие Двойной щелчок и запускает файл путь которого достаточно скопировать в ячейку.
Цитата Manyasha, 28.01.2016 в 11:43, в сообщении № 9
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Columns(5)) Is Nothing Then
        If Target.Value <> "" Then
            fPath = "start " & """"" " & """" & Target.Value & """"""
            Shell "cmd /c" & fPath, vbHide: Cancel = True
        End If
    End If
End Sub
[/vba]


Хотелось бы узнать можно ли усовершенстовать данный код чтобы в ячейке отображалось только имя файла без полного пути. Но при этом по двойному щелчку открывался бы сам файл.

Автор - fairylive
Дата добавления - 29.01.2016 в 18:07
Manyasha Дата: Пятница, 29.01.2016, 21:27 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
fairylive, формулы рассматриваете? Предлагаю имя файла так возвращать (массивная, вводить через ctrl+shift+enter)
Код
=ПСТР(D1;МАКС((ПСТР(D1;СТРОКА($1:$999);1)="\")*СТРОКА($1:$999))+1;999)

А сам столбец с полным именем можно скрыть, в коде только одно место поправить нужно будет
[vba]
Код
fPath = "start " & """"" " & """" & Target.Offset(0, -1).Value & """"""
[/vba]
К сообщению приложен файл: 1111.xlsm (16.0 Kb)


ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеfairylive, формулы рассматриваете? Предлагаю имя файла так возвращать (массивная, вводить через ctrl+shift+enter)
Код
=ПСТР(D1;МАКС((ПСТР(D1;СТРОКА($1:$999);1)="\")*СТРОКА($1:$999))+1;999)

А сам столбец с полным именем можно скрыть, в коде только одно место поправить нужно будет
[vba]
Код
fPath = "start " & """"" " & """" & Target.Offset(0, -1).Value & """"""
[/vba]

Автор - Manyasha
Дата добавления - 29.01.2016 в 21:27
fairylive Дата: Пятница, 29.01.2016, 22:18 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 122
Репутация: 4 ±
Замечаний: 0% ±

Excel 2016
Формулы не очень хороши тем что кому-то надо их периодически продливать вниз (90% это делать умеют, но есть и такие кто с компьютером на Вы, собственно для них все эти формулы и функции полная дичь и именно эти люди тратят кучу времени на заполнение этой таблицы и именно они чаще других конфликтуют с другими). И скрытый столбец тоже не вариант так как туда же мы хотели вставлять имя файла. Хотя тут можно один раз сделать группировку и открывать\закрывать его. Цель - открыть файл, быстро внести изменения и выйти, чтобы не мешать другим.

В идеале как я это вижу: Мы скопировали путь к файлу в буфер обмена. Затем выделяем ячейку и по событию или сочетанию клавиш, с помощью макроса или кода VBA в данной ячейке появляется имя файла, при этом двойной щёлчок по имени должен открывать сам файл. Если заполнять выделенную ячейку тем же событием Двойной щелчок то надо чтобы была какая-то проверка - пока пусто заполняется ячейка (данные берутся из буфера обмена и там должен быть только путь), если в ячейке уже что-то есть то по двойному щелчку пытаться это что-то открыть.
 
Ответить
СообщениеФормулы не очень хороши тем что кому-то надо их периодически продливать вниз (90% это делать умеют, но есть и такие кто с компьютером на Вы, собственно для них все эти формулы и функции полная дичь и именно эти люди тратят кучу времени на заполнение этой таблицы и именно они чаще других конфликтуют с другими). И скрытый столбец тоже не вариант так как туда же мы хотели вставлять имя файла. Хотя тут можно один раз сделать группировку и открывать\закрывать его. Цель - открыть файл, быстро внести изменения и выйти, чтобы не мешать другим.

В идеале как я это вижу: Мы скопировали путь к файлу в буфер обмена. Затем выделяем ячейку и по событию или сочетанию клавиш, с помощью макроса или кода VBA в данной ячейке появляется имя файла, при этом двойной щёлчок по имени должен открывать сам файл. Если заполнять выделенную ячейку тем же событием Двойной щелчок то надо чтобы была какая-то проверка - пока пусто заполняется ячейка (данные берутся из буфера обмена и там должен быть только путь), если в ячейке уже что-то есть то по двойному щелчку пытаться это что-то открыть.

Автор - fairylive
Дата добавления - 29.01.2016 в 22:18
Karataev Дата: Суббота, 30.01.2016, 11:07 | Сообщение № 4
Группа: Проверенные
Ранг: Старожил
Сообщений: 1334
Репутация: 533 ±
Замечаний: 0% ±

Excel
Макрос работает так. Если в ячейке пусто, то появится диалоговое окно, в которое нужно вставить путь и имя файла. После этого в ячейке появится формула с функцией Гиперссылка. Если же в ячейке уже будут данные, то при двойном щелчке произойдет открытие файла (т.к. произойдет щелчок по гиперссылке).
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    Dim strPath As String, lngInstr As Long
    
    Cancel = True
    If Target.Value <> "" Then Exit Sub
    strPath = InputBox("Вставьте путь файла:")
    If strPath = "" Then Exit Sub
    lngInstr = InStrRev(strPath, "\")
    Target.Value = "=HYPERLINK(" & """" & strPath & """" & "," & """" & Mid(strPath, lngInstr + 1) & """" & ")"
    
End Sub
[/vba]
 
Ответить
СообщениеМакрос работает так. Если в ячейке пусто, то появится диалоговое окно, в которое нужно вставить путь и имя файла. После этого в ячейке появится формула с функцией Гиперссылка. Если же в ячейке уже будут данные, то при двойном щелчке произойдет открытие файла (т.к. произойдет щелчок по гиперссылке).
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    Dim strPath As String, lngInstr As Long
    
    Cancel = True
    If Target.Value <> "" Then Exit Sub
    strPath = InputBox("Вставьте путь файла:")
    If strPath = "" Then Exit Sub
    lngInstr = InStrRev(strPath, "\")
    Target.Value = "=HYPERLINK(" & """" & strPath & """" & "," & """" & Mid(strPath, lngInstr + 1) & """" & ")"
    
End Sub
[/vba]

Автор - Karataev
Дата добавления - 30.01.2016 в 11:07
fairylive Дата: Суббота, 30.01.2016, 17:30 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 122
Репутация: 4 ±
Замечаний: 0% ±

Excel 2016
Karataev, что-то не работает как надо. Ошибка выскакивает. Хотя я тут разобрался. Дело в том что когда в то окошко копируется путь он уже заключен в кавычки. Если их убрать то всё работает. Напомню что если щёлкнуть по файлу правой клавишей мыши с зажатым SHIFT то в контекстном меню появляется строчка Копировать как путь. При этом в буфер обмена помещается путь в кавычках. Например "C:\Users\Вова\Documents\титры в edl.xlsx". Так что код надо поправить. Я правда пока не понимаю как. Слишком много двойных кавычек для меня.
 
Ответить
СообщениеKarataev, что-то не работает как надо. Ошибка выскакивает. Хотя я тут разобрался. Дело в том что когда в то окошко копируется путь он уже заключен в кавычки. Если их убрать то всё работает. Напомню что если щёлкнуть по файлу правой клавишей мыши с зажатым SHIFT то в контекстном меню появляется строчка Копировать как путь. При этом в буфер обмена помещается путь в кавычках. Например "C:\Users\Вова\Documents\титры в edl.xlsx". Так что код надо поправить. Я правда пока не понимаю как. Слишком много двойных кавычек для меня.

Автор - fairylive
Дата добавления - 30.01.2016 в 17:30
Karataev Дата: Суббота, 30.01.2016, 17:35 | Сообщение № 6
Группа: Проверенные
Ранг: Старожил
Сообщений: 1334
Репутация: 533 ±
Замечаний: 0% ±

Excel
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    Dim strPath As String, lngInstr As Long
    
    Cancel = True
    If Target.Value <> "" Then Exit Sub
    strPath = InputBox("Вставьте путь файла:")
    If strPath = "" Then Exit Sub
    strPath = Mid(strPath, 2, Len(strPath) - 2)
    lngInstr = InStrRev(strPath, "\")
    Target.Value = "=HYPERLINK(" & """" & strPath & """" & "," & """" & Mid(strPath, lngInstr + 1) & """" & ")"
    
End Sub
[/vba]
 
Ответить
Сообщение[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    Dim strPath As String, lngInstr As Long
    
    Cancel = True
    If Target.Value <> "" Then Exit Sub
    strPath = InputBox("Вставьте путь файла:")
    If strPath = "" Then Exit Sub
    strPath = Mid(strPath, 2, Len(strPath) - 2)
    lngInstr = InStrRev(strPath, "\")
    Target.Value = "=HYPERLINK(" & """" & strPath & """" & "," & """" & Mid(strPath, lngInstr + 1) & """" & ")"
    
End Sub
[/vba]

Автор - Karataev
Дата добавления - 30.01.2016 в 17:35
fairylive Дата: Суббота, 30.01.2016, 17:46 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 122
Репутация: 4 ±
Замечаний: 0% ±

Excel 2016
Karataev, спасибо теперь работает.
 
Ответить
СообщениеKarataev, спасибо теперь работает.

Автор - fairylive
Дата добавления - 30.01.2016 в 17:46
fairylive Дата: Суббота, 30.01.2016, 18:28 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 122
Репутация: 4 ±
Замечаний: 0% ±

Excel 2016
Вот немного доделал чтобы данный макрос работал только с пятым столбцом. Вроде работает. Я в этом ничего не понимаю пока. Просто добавил две строчки из кода в первом сообщении.

[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Columns(5)) Is Nothing Then
    Dim strPath As String, lngInstr As Long
    
    Cancel = True
    If Target.Value <> "" Then Exit Sub
    strPath = InputBox("Вставьте путь файла:")
    If strPath = "" Then Exit Sub
    strPath = Mid(strPath, 2, Len(strPath) - 2)
    lngInstr = InStrRev(strPath, "\")
    Target.Value = "=HYPERLINK(" & """" & strPath & """" & "," & """" & Mid(strPath, lngInstr + 1) & """" & ")"
    End If
End Sub
[/vba]
 
Ответить
СообщениеВот немного доделал чтобы данный макрос работал только с пятым столбцом. Вроде работает. Я в этом ничего не понимаю пока. Просто добавил две строчки из кода в первом сообщении.

[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Columns(5)) Is Nothing Then
    Dim strPath As String, lngInstr As Long
    
    Cancel = True
    If Target.Value <> "" Then Exit Sub
    strPath = InputBox("Вставьте путь файла:")
    If strPath = "" Then Exit Sub
    strPath = Mid(strPath, 2, Len(strPath) - 2)
    lngInstr = InStrRev(strPath, "\")
    Target.Value = "=HYPERLINK(" & """" & strPath & """" & "," & """" & Mid(strPath, lngInstr + 1) & """" & ")"
    End If
End Sub
[/vba]

Автор - fairylive
Дата добавления - 30.01.2016 в 18:28
fairylive Дата: Четверг, 07.04.2016, 15:29 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 122
Репутация: 4 ±
Замечаний: 0% ±

Excel 2016
Помогите доработать макрос. На некоторых компах при вставке в появляющееся окно Пути файла вставляются знаки вопроса вместо русских букв. Надо что-то с кодировкой сделать. Пока не могу найти что именно.
 
Ответить
СообщениеПомогите доработать макрос. На некоторых компах при вставке в появляющееся окно Пути файла вставляются знаки вопроса вместо русских букв. Надо что-то с кодировкой сделать. Пока не могу найти что именно.

Автор - fairylive
Дата добавления - 07.04.2016 в 15:29
Karataev Дата: Четверг, 07.04.2016, 15:38 | Сообщение № 10
Группа: Проверенные
Ранг: Старожил
Сообщений: 1334
Репутация: 533 ±
Замечаний: 0% ±

Excel
Перед копированием кода, нужно переключить раскладку клавиатуры на русский язык.
 
Ответить
СообщениеПеред копированием кода, нужно переключить раскладку клавиатуры на русский язык.

Автор - Karataev
Дата добавления - 07.04.2016 в 15:38
fairylive Дата: Четверг, 07.04.2016, 15:52 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 122
Репутация: 4 ±
Замечаний: 0% ±

Excel 2016
Перед копированием кода, нужно переключить раскладку клавиатуры на русский язык.


Протестил на своем компе (до этого всегда вставлялось всё нормально). Действительно так. От расскладки зависит. Спасибо!

Внёс пока в текст окна подсказку чтобы люди не забывали переключать расскладку на RU.

Получается код никак не допилить по этому поводу?
 
Ответить
Сообщение
Перед копированием кода, нужно переключить раскладку клавиатуры на русский язык.


Протестил на своем компе (до этого всегда вставлялось всё нормально). Действительно так. От расскладки зависит. Спасибо!

Внёс пока в текст окна подсказку чтобы люди не забывали переключать расскладку на RU.

Получается код никак не допилить по этому поводу?

Автор - fairylive
Дата добавления - 07.04.2016 в 15:52
al-Ex Дата: Четверг, 07.04.2016, 16:17 | Сообщение № 12
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 190
Репутация: 59 ±
Замечаний: 0% ±

Excel 2010
Получается код никак не допилить
"Допилить" можно. Нужно в коде макроса сначала изменить раскладку клавиатуры на "RU", потом уже далее выполнять что нужно.Как это делается? "Пример тут"
В Вашем случае, примерно так должно выглядеть:


Сообщение отредактировал al-Ex - Четверг, 07.04.2016, 19:06
 
Ответить
Сообщение
Получается код никак не допилить
"Допилить" можно. Нужно в коде макроса сначала изменить раскладку клавиатуры на "RU", потом уже далее выполнять что нужно.Как это делается? "Пример тут"
В Вашем случае, примерно так должно выглядеть:

Автор - al-Ex
Дата добавления - 07.04.2016 в 16:17
Karataev Дата: Четверг, 07.04.2016, 16:20 | Сообщение № 13
Группа: Проверенные
Ранг: Старожил
Сообщений: 1334
Репутация: 533 ±
Замечаний: 0% ±

Excel
Получается код никак не допилить по этому поводу?

Я не понял вопроса, что допилить надо?


Сообщение отредактировал Karataev - Четверг, 07.04.2016, 20:26
 
Ответить
Сообщение
Получается код никак не допилить по этому поводу?

Я не понял вопроса, что допилить надо?

Автор - Karataev
Дата добавления - 07.04.2016 в 16:20
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Усовершенствование гиперссылки (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!