Здравствуйте. Помогите написать макрос. Есть макрос, который работает как гиперссылка - открывает конкретный сторонний файл. Можно прицепить этот макрос - к определенной картинке.
Сейчас в моем файле - назначение гиперссылки выглядит так: [vba]
Код
Function fOpenFile(sFPath As String) As Boolean On Error Resume Next fOpenFile = ShellExecute(0&, "Open", sFPath, _ vbNullString, vbNullString, 1&) > 32 End Function
Sub Макрос_1() If Not fOpenFile(Range("F5")) Then MsgBox "не удалось открыть файл!" End If End Sub
[/vba] Но этот макрос действует только на одну картинку, а на другую картинку нужно писать уже другой макрос.
Как заставить макрос открывать файл по адресу - не конкретной ячейки, а по адресу ближайшей заполненной ячейки которая находится ближе всех к центру картинки той картинки, по которой осуществляется щелчок ? Чтобы можно один макрос - назначить всем картинкам разом.
Здравствуйте. Помогите написать макрос. Есть макрос, который работает как гиперссылка - открывает конкретный сторонний файл. Можно прицепить этот макрос - к определенной картинке.
Сейчас в моем файле - назначение гиперссылки выглядит так: [vba]
Код
Function fOpenFile(sFPath As String) As Boolean On Error Resume Next fOpenFile = ShellExecute(0&, "Open", sFPath, _ vbNullString, vbNullString, 1&) > 32 End Function
Sub Макрос_1() If Not fOpenFile(Range("F5")) Then MsgBox "не удалось открыть файл!" End If End Sub
[/vba] Но этот макрос действует только на одну картинку, а на другую картинку нужно писать уже другой макрос.
Как заставить макрос открывать файл по адресу - не конкретной ячейки, а по адресу ближайшей заполненной ячейки которая находится ближе всех к центру картинки той картинки, по которой осуществляется щелчок ? Чтобы можно один макрос - назначить всем картинкам разом.mv6677
Sub Макрос() Dim i, j, r, c, s Set s = ActiveSheet.Shapes(Application.Caller) r = s.TopLeftCell.Row c = s.TopLeftCell.Column For i = 1 To 10 For j = 0 To 10 If Len(Cells(r + i, c + j)) > 0 Then MsgBox Cells(r + i, c + j).Value Exit Sub End If Next j Next i End Sub
[/vba]
Цитата
Чтобы можно один макрос - назначить всем картинкам разом.
лучше картинки загрузить в массив
[vba]
Код
Sub Макрос() Dim i, j, r, c, s Set s = ActiveSheet.Shapes(Application.Caller) r = s.TopLeftCell.Row c = s.TopLeftCell.Column For i = 1 To 10 For j = 0 To 10 If Len(Cells(r + i, c + j)) > 0 Then MsgBox Cells(r + i, c + j).Value Exit Sub End If Next j Next i End Sub
[/vba]
Цитата
Чтобы можно один макрос - назначить всем картинкам разом.