|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
07.04.2011, 10:37 | #1 |
Пользователь
Регистрация: 05.04.2011
Сообщений: 14
|
Ссылки на другие ячейки в другие книги
Помогите пожалуйста, не могу дописать макрос пару строк, что то недопонимаю. Нужно чтобы в основной книге образовались ссылки на ячейки во всех книгах расположенных в папке. Я сделал: папку ищет, книги все находит, а вот именно ссылку никак не вставляет в ячейку основной книги. Прилагаю и код (проблемный момент выделен):
Private Sub CommandButton1_Click() start: DestinationFolder = GetFolderPath("Выберите папку для просмотра списка файлов", "c:\") ' можешь заменить C:\Windows\ на любой другой путь, с которого должен начинаться выбор папки If DestinationFolder = "" Then Select Case MsgBox("Папка для просмотра не выбрана. Повторить?", vbQuestion + vbOKCancel, "Папка не выбрана") Case vbOK: GoTo start Case vbCancel: Exit Sub End Select Else CreateDirectoryListing DestinationFolder End If End Sub Function GetFolderPath(Optional ByVal Title As String = "Выберите папку", Optional ByVal InitialPath As String = "c:\") As String GetFolderPath = "": PS = Application.PathSeparator With Application.FileDialog(msoFileDialo gFolderPicker) .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath If .Show = -1 Then GetFolderPath = .SelectedItems(1): If Not Right$(GetFolderPath, 1) = PS Then GetFolderPath = GetFolderPath & PS End With End Function Sub CreateDirectoryListing(Optional ByVal FolderPath As String = "c:\") On Error Resume Next 'Dim fso As FileSystemObject, f As Folder, fl As File, fld As Folder Set fso = CreateObject("Scripting.FileSystemO bject") Set f = fso.GetFolder(FolderPath) Application.ScreenUpdating = False Set sh = ActiveSheet ro = 2 With sh ro = ro + 1 For Each fl In f.Files .Cells(ro, 1) = fl.Name ' хотелось бы без .xls, но хрен с ним .Cells(ro, 2).ActiveCell.FormulaR1C1 = "='С:\Задача\[1020.xls]Результат'!$А$1]" 'как сделать чтобы менялось имя файла в пути, да и на экране вообще ничего не выходит .Cells(ro, 3) = ActiveCell.FormulaR1C1 = "='С:\Задача\[1020.xls]Результат'!$D$59]" 'не выводит на экран .Cells(ro, 4) = ActiveCell.FormulaR1C1 = "='С:\Задача\[1020.xls]Результат'!$C$59]" 'не выводит на экран ro = ro + 1: DoEvents Next .Columns("a:e").AutoFit .UsedRange.HorizontalAlignment = xlCenter SetRangeBordersEx .UsedRange, xlContinuous, xlThin End With Application.ScreenUpdating = True End Sub Function FileOrFolderSize(ByVal s) As String Size = Fix(Val(s)): ' If s = "" Then FileOrFolderSize = "<нет доступа>" Select Case Size Case Is < 1000: FileOrFolderSize = Size & " байт" Case Is < 10000: FileOrFolderSize = FormatNumber(Size / 1024, 1) & " Кб" Case Is < 1000000: FileOrFolderSize = FormatNumber(Size \ 1024, 0) & " Кб" Case Is < 10000000: FileOrFolderSize = FormatNumber(Size / 1024 / 1024, 1) & " Mб" Case Is < 1000000000: FileOrFolderSize = FormatNumber(Size / 1024 / 1024, 0) & " Мб" Case Else: FileOrFolderSize = FormatNumber(Size / 1024 / 1024 / 1024, 1) & " Гб" End Select End Function Sub SetRangeBordersEx(ByRef ra As Range, ByVal BordersLineStyle As XlLineStyle, ByVal BordersWeight As XlBorderWeight) ra.Borders.LineStyle = BordersLineStyle ra.Borders.Weight = BordersWeight ra.Borders(xlDiagonalDown).LineStyl e = xlNone ra.Borders(xlDiagonalUp).LineStyle = xlNone End Sub[/I][/I] и файл, кому как удобно. Спасибо!!! Последний раз редактировалось Nick-1984; 07.04.2011 в 10:41. |
07.04.2011, 11:50 | #2 |
Программист VBA
СуперМодератор
Регистрация: 13.07.2008
Сообщений: 6,856
|
Так пробовали?
Код:
|
07.04.2011, 12:45 | #3 |
Пользователь
Регистрация: 05.04.2011
Сообщений: 14
|
Сейчас попробую!!!
|
07.04.2011, 12:52 | #4 |
Пользователь
Регистрация: 05.04.2011
Сообщений: 14
|
Работает блин. Но как? Я пробовал так делать, ни дыры не работало. Эту хрень "= ActiveCell.FormulaR1C1 " я уже от безисходности добавил. Короче С П А С И Б О !!!!!!!!!!!!!!!!!!!!!!
|
07.04.2011, 14:23 | #5 |
Пользователь
Регистрация: 05.04.2011
Сообщений: 14
|
А можно во этот путь (выделено жирным)
.Cells(ro, 2) = "='С:\Задача\[" & fl.Name & "]Результат'!$А$1" Заменить на путь который мы выбираем в начале, когда указываем в какой папке расположены Книги (помоему здесь): Sub CreateDirectoryListing(Optional ByVal FolderPath As String = "c:\") On Error Resume Next 'Dim fso As FileSystemObject, f As Folder, fl As File, fld As Folder Set fso = CreateObject("Scripting.FileSystemO bject") Set f = fso.GetFolder(FolderPath) Было бы вообще здорово!!!! |
08.04.2011, 10:23 | #6 |
Пользователь
Регистрация: 05.04.2011
Сообщений: 14
|
Все сам решил проблему!!!!!!!!!!!
.Cells(ro, 2) = "='" & f & "\[" & fl.Name & "]Отчетность!$D$59" |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Копировать из одной книги в другие Excel-2003 | vfv | Microsoft Office Excel | 1 | 18.01.2011 22:38 |
Скопировать данные из некоторых ячеек одной книги в другие книги | fcunited | Microsoft Office Excel | 8 | 09.06.2010 12:14 |
Напишите ссылки на другие форумы, в т.ч. и иностранные | Busine2009 | Microsoft Office Word | 1 | 05.06.2009 11:11 |
Ссылки на аудио/видео и другие файлы. | Amen | Мультимедиа в Delphi | 7 | 25.01.2009 18:46 |
Ссылки на другие книги | Un1kum | Microsoft Office Excel | 1 | 10.07.2008 05:12 |