Страницы: 1
RSS
Чтение данных из другой книги в Visual Basic
 
Здраствуйте. Помогите пожалуйста решить проблему:  
Есть Книга 1. Нужно написать програмку на Visual Basic которая перекачивает данные из Листа 1 Книги 1 в Лист 1 Книги 2. Открыта может быть только Книга 2. Книга 1 закрыта.  
 
Вот код который переносит данные из одного листа в другой :  
 
Sub Перекачка_организаций()  
   For i = 2 To 50  
       Имя_Организации = Sheets("Организации").Cells(i, 1).Value  
       ИНН_Организации = Sheets("Организации").Cells(i, 3).Value  
 
       Sheets("Список").Cells(i, 1).Value = Имя_Организации  
       Sheets("Список").Cells(i, 2).Value = ИНН_Организации  
   Next  
End Sub  
 
Наверное для перекачки книг код не будет сложнее.  
Заранее благодарен.
 
а что значит книга закрыта?  
 
ее нельзя показывать? почему нельзя открыть?  
 
можно просто импортировать - данные-импорт внешних данных-импортировать данные
Живи и дай жить..
 
Книгу 1 надо открыть.  
 
Dim wkb1 As Workbook, wks1 As Worksheet  
 
Set wkb1 = Workbooks.Open("C:\Книга1.xls")  
Set wks1 = wkb1.Sheets("Лист1")
There is no knowledge that is not power
 
Книга закрыта значит что Excel файл не открыт. Желательно чтобы он не открывался. А данные просто считывались с файла.
 
{quote}{login=olegkuzn}{date=06.05.2011 11:48}{thema=}{post}Книга закрыта значит что Excel файл не открыт. Желательно чтобы он не открывался. А данные просто считывались с файла.{/post}{/quote}  
 
Можно использовать SQL запрос.  
 
Dim rs As Recordset  
rs.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _  
                           "Data Source=" & ПУТЬ_К_КНИГЕ_1 & ";" & _  
                           "Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1;"";"  
rs.Source = "SELECT * FROM Лист1"  
rs.Open  
 
Range("A1").CopyFromRecordset rs
There is no knowledge that is not power
 
Поправочка  
 
rs.Source = "SELECT * FROM [Лист1$]"
There is no knowledge that is not power
 
Так например:  
 
 
Sub ПримерИспользования_GetFileName()  
ИмяФайла = GetFileName("Заголовок окна", ThisWorkbook.Path) ' запрашиваем имя файла  
' ===================== другие варианты вызова функции =====================  
' текстовые файлы, стартовая папка не указана  
' ИмяФайла = GetFileName("Выберите текстовый файл", , "Текстовые файлы (*.txt),")  
' файлы любого типа из папки "C:\Windows"  
' ИмяФайла = GetFileName(, "C:\Windows", "")  
' ============================================================­==============  
 
If ИмяФайла = "" Then Exit Sub ' выход, если пользователь отказался от выбора файла  
'MsgBox "Выбран файл: " & ИмяФайла, vbInformation  
With GetObject(ИмяФайла)  
ThisWorkbook.Sheets(1).[a1] = .Sheets(1).[a1]
.Close 0  
End With  
End Sub
 
Формульным методом:  
 
With Range("'[Книга2.xls]Лист1'!A2:B50")
   .FormulaArray = "=IF('B:\test\[Книга1.xls]Лист1'!A2:B50="""","""",'B:\test\[Книга1.xls]Лист1'!A2:B50)"
   .Value = .Value  
End With
 
Ещё два похожих варианта:  
 
With GetObject(ИмяФайла)  
.Sheets(1).[a1:b10].Copy ThisWorkbook.Sheets(1).[a1]
'ThisWorkbook.Sheets(1).[a1:b10].Value = .Sheets(1).[a1:b10].Value
.Close 0  
End With
 
Саму функцию забыл...  
 
Function GetFileName(Optional ByVal Title As String = "Выберите файл для обработки", _  
Optional ByVal InitialPath, _  
Optional ByVal MyFilter As String = "Книги Excel (*.xls*),") As String  
' функция выводит диалоговое окно выбора папки с заголовком Title,  
' начиная обзор диска с папки InitialPath  
' возвращает полный путь к выбранной папке, или пустую строку в случае отказа от выбора  
If Not IsMissing(InitialPath) Then  
On Error Resume Next: ChDrive Left(InitialPath, 1)  
ChDir InitialPath ' выбираем стартовую папку  
End If  
res = Application.GetOpenFilename(MyFilter, , Title, "Открыть") ' вывод диалогового окна  
GetFileName = IIf(VarType(res) = vbBoolean, "", res) ' пустая строка при отказе от выбора  
End Function
Страницы: 1
Читают тему
Наверх