Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
макрос для создания гиперссылок на файлы
 
#1
28.02.2011 11:24:15
Добрый день!  
Есть папка с графическими файлами (jpg, gif и png). Есть файл, в котором перечислены названия файлов без расширения. Нужно создать макрос, который бы проставлял а таблице гиперссылки на эти файлы. Excel 2007! Помогите, пожалуйста!  
На этом форуме я уже нашла тему, где писали макрос для выбора картинок, (http://www.planetaexcel.ru/forum.php?thread_id=9966)я его и использовала, но мне нужно не только выбрать, но и создать гиперссылки.
 
 
 
#2
28.02.2011 11:32:01
Так.
Я сам - дурнее всякого примера! ...
 
 
 
#3
28.02.2011 12:04:46
Большое спасибо! А как бы теперь еще учесть, что расширения файлов могут быть разные: jpg, gif и png?
 
 
 
#4
28.02.2011 12:45:26
xsenia, трудно залогиниться?
Я сам - дурнее всякого примера! ...
 
 
 
#5
28.02.2011 13:08:55
Не трудно. Спасибо! А можно еще вопросик: как сделать тоже самое для этого кода:  
 
Sub Move_Files()  
   Dim sFilesPath As String, sNewPath As String  
   Dim lLastRow As Long, li As Long  
   With Application.FileDialog(msoFileDialogFolderPicker)  
       If .Show = False Then Exit Sub  
       sFilesPath = .SelectedItems(1)  
   End With  
   sFilesPath = IIf(Right(sFilesPath, 1) = Application.PathSeparator, sFilesPath, sFilesPath & Application.PathSeparator)  
   sNewPath = sFilesPath & "MovingFiles\"  
   If Dir(sFilesPath) = "" Then MsgBox "Íåâåðíî óêàçàí ïóòü ê ôàéëàì.", vbCritical, "Îøèáêà": Exit Sub  
   If Dir(sNewPath) = "" Then MkDir sNewPath  
   lLastRow = Cells(Rows.Count, 1).End(xlUp).Row  
   Application.ScreenUpdating = False  
   For li = 1 To lLastRow  
       If Cells(li, 1) <> "" Then  
           If Dir(sFilesPath & Cells(li, 1) & ".jpg") <> "" Then _  
              Name sFilesPath & Cells(li, 1) & ".jpg" As sNewPath & Cells(li, 1) & ".jpg"  
       End If  
   Next li  
   Application.ScreenUpdating = True  
   MsgBox "Ôàéëû ïåðåìåùåíû", vbInformation, "Èíôîðìàöèîííîå îêíî"  
End Sub  
 
а то там сейчас только ".jpg"
 
 
 
#6
28.02.2011 13:33:47
С любыми расширениями:  
Sub Move_Files()  
   Dim sFilesPath As String, sNewPath As String  
   Dim lLastRow As Long, li As Long, fn$  
   With Application.FileDialog(msoFileDialogFolderPicker)  
       If .Show = False Then Exit Sub  
       sFilesPath = .SelectedItems(1)  
   End With  
   sFilesPath = IIf(Right(sFilesPath, 1) = Application.PathSeparator, sFilesPath, sFilesPath & Application.PathSeparator)  
   sNewPath = sFilesPath & "MovingFiles\"  
   If Dir(sFilesPath) = "" Then MsgBox "Неверно указан путь к файлам.", vbCritical, "Ошибка": Exit Sub  
   If Dir(sNewPath) = "" Then MkDir sNewPath  
   lLastRow = Cells(Rows.Count, 1).End(xlUp).Row  
   Application.ScreenUpdating = False  
   For li = 1 To lLastRow  
       If Cells(li, 1) <> "" Then  
           If Dir(sFilesPath & Cells(li, 1) & ".*") <> "" Then  
           fn = Dir(sFilesPath & Cells(li, 1) & ".*")  
             
              Name sFilesPath & fn As sNewPath & fn  
       End If  
       End If  
   Next li  
   Application.ScreenUpdating = True  
   MsgBox ""  
End Sub
Я сам - дурнее всякого примера! ...
 
 
 
#7
28.02.2011 13:33:58
Я не знаю, какой файл с каким расширением, как же я расширение в ячейку впишу? Можно сделать несколько столбцов для разных вариантов, но мне кажется, это далеко не оптимально. Как сделать, чтобы макрос находил файлы с любым расширением? Звездочка, как в коде из post_204146.xls не помогла в данном случае, или я ее не туда поставила.
 
 
 
#8
28.02.2011 13:35:05
Спасибо! Пока писала вопрос, Вы уже ответили
 
 
 
#9
28.02.2011 13:37:51
{quote}{login=xsenia}{date=28.02.2011 01:33}{thema=}{post}Звездочка, как в коде из post_204146.xls не помогла в данном случае, или я ее не туда поставила.{/post}{/quote}Помогла.
Я сам - дурнее всякого примера! ...
 
 
 
#10
28.02.2011 15:37:41
xsenia,  
на будущее совет: работая под Вистой (не знаю, как под Семёркой, а под этой ... Вистой, так точно), при копировании текста с кириллицей, переключайте сначала раскладку клавиатуры на RUS, тогда после вставки в тексте не будет гадостей типа:  
MsgBox "Ôàéëû ïåðåìåùåíû", vbInformation, "Èíôîðìàöèîííîå îêíî"
С уважением, Алексей (ИМХО: Excel-2003 - THE BEST!!!)
 
 
 
#11
28.02.2011 15:58:20
Леш, я се ЮДФку написал. Для конверсии зябликов в строку:-)
Я сам - дурнее всякого примера! ...
 
 
 
#12
28.02.2011 17:05:48
{quote}работая под Вистой {/quote}  
Буду иметь в виду, хотя у меня XP.
 
 
 
#13
28.02.2011 17:58:09
Юра писал, что у него и под хрюшкой то же.
Я сам - дурнее всякого примера! ...
 
 
 
Страницы: 1
Читают тему
Наверх