Ссылки на другие ячейки в другие книги

[Nick-1984]

Помогите пожалуйста, не могу дописать макрос пару строк, что то недопонимаю. Нужно чтобы в основной книге образовались ссылки на ячейки во всех книгах расположенных в папке. Я сделал: папку ищет, книги все находит, а вот именно ссылку никак не вставляет в ячейку основной книги. Прилагаю и код (проблемный момент выделен):

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]

и файл, кому как удобно.
Спасибо!!!

[EducatedFool]

Так пробовали?

For Each fl In f.Files
    .Cells(ro, 1) = Split(fl.Name, ".xls")(0)
    .Cells(ro, 2) = "='С:\Задача\[" & fl.Name & "]Результат'!$А$1"
    .Cells(ro, 3) = "='С:\Задача\[" & fl.Name & "]Результат'!$D$59"
    .Cells(ro, 4) = "='С:\Задача\[" & fl.Name & "]Результат'!$C$59"
    ro = ro + 1: DoEvents
Next

[Nick-1984]

Сейчас попробую!!!

[Nick-1984]

Работает блин. Но как? Я пробовал так делать, ни дыры не работало. Эту хрень "= ActiveCell.FormulaR1C1 " я уже от безисходности добавил. Короче С П А С И Б О !!!!!!!!!!!!!!!!!!!!!!

[Nick-1984]

А можно во этот путь (выделено жирным)
.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)
Было бы вообще здорово!!!!

[Nick-1984]

Все сам решил проблему!!!!!!!!!!!
.Cells(ro, 2) = "='" & f & "\[" & fl.Name & "]Отчетность!$D$59"