ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Повторить операцию
20 сообщений из 20, страница 1 из 1
Повторить операцию
    #33592143
Loll
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Loll
Гость
Есть вот такой код:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
Sub Теcт()

Set oShell = CreateObject("Shell.Application")
Set NewSheet = ActiveSheet
With Application.FileSearch
    .LookIn = oShell.BrowseForFolder( 0 , "Выберите папку с заказом",  0 )
    .Filename = "*.xls"
    If .Execute >  0  Then
     For i =  1  To .FoundFiles.Count
        Files = .FoundFiles(i)
        Workbooks.Open Filename:=Files
        ActiveWorkbook.Worksheets( 3 ).UsedRange.Copy
        NewSheet.Paste Destination:=NewSheet.Range("A1")
        ActiveWorkbook.Close
     Next
    Else
     MsgBox ("Не найдены файлы")
    End If
End With
End Sub

Он копирует содержимое третьего листа книг по шаблону в указанной мной папке. Но делает он это только с одним файлом, а мне нужно чтобы это были все файлы найденные Application.FileSearch и чтобы копии из файлов помещались на разные листы.
...
Рейтинг: 0 / 0
10.03.2006, 11:45:40
| Ответить | Цитировать | Написать  
Повторить операцию
    #33592274
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
Sub Тест()
Dim xlAp As New Excel.Application
Dim xlWb As Excel.Workbook
Dim rng As Range

Set oShell = CreateObject("Shell.Application")
With Application.FileSearch
    .LookIn = oShell.BrowseForFolder( 0 , "Выберите папку с заказом",  0 )
    .Filename = "*.xls"
    If .Execute >  0  Then
     For i =  1  To .FoundFiles.Count
        Files = .FoundFiles(i)
        'Workbooks.Open Filename:=Files
        Set xlWb = xlAp.Workbooks.Open(Files, , True)
        Set rng = xlWb.Worksheets( 1 ).UsedRange
        rng.Copy
        Set NewSheet = ActiveWorkbook.Sheets.Add
        NewSheet.Paste Destination:=NewSheet.Range("A1")
        
        Application.CutCopyMode = False
        xlWb.Close
     Next
    Else
     MsgBox ("Не найдены файлы")
    End If
End With
Set xlWb = Nothing
Set rng = Nothing
Set NewSheet = Nothing
End Sub
...
Рейтинг: 0 / 0
10.03.2006, 12:15:29
| Ответить | Цитировать | Написать  
Повторить операцию
    #33592283
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
измени
Код: plaintext
Set rng = xlWb.Worksheets( 1 ).UsedRange
на
Код: plaintext
Set rng = xlWb.Worksheets( 3 ).UsedRange
...
Рейтинг: 0 / 0
10.03.2006, 12:17:22
| Ответить | Цитировать | Написать  
Повторить операцию
    #33592558
Loll
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Loll
Гость
Все классно работает, только вот листы получаются перепутаны :( Мне нужно чтобы первый лист был пустым, а остальные по порядку как файлы в папке.
...
Рейтинг: 0 / 0
10.03.2006, 13:13:25
| Ответить | Цитировать | Написать  
Повторить операцию
    #33592565
Loll
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Loll
Гость
И если не трудно еще подскажите как сделать не на разных листах, а на одном по порядку?
...
Рейтинг: 0 / 0
10.03.2006, 13:16:24
| Ответить | Цитировать | Написать  
Повторить операцию
    #33592715
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
Lollи чтобы копии из файлов помещались на разные листы.
Loll
если не трудно еще подскажите как сделать не на разных листах, а на одном по порядку?
ты уж определись.
...
Рейтинг: 0 / 0
10.03.2006, 13:54:38
| Ответить | Цитировать | Написать  
Повторить операцию
    #33592817
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
ты наверное хотел на разных страницах в одном листе так?
если так то попробуй
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
Sub Теcт()
Dim xlAp As New Excel.Application
Dim xlWb As Excel.Workbook
Dim rng As Range
Dim n As Long
n =  1 
Set oShell = CreateObject("Shell.Application")
Set NewSheet = ActiveWorkbook.ActiveSheet
With Application.FileSearch
    .LookIn = oShell.BrowseForFolder( 0 , "Выберите папку с заказом",  0 )
    .Filename = "*.xls"
    If .Execute >  0  Then
     For i =  1  To .FoundFiles.Count
        Files = .FoundFiles(i)
        Set xlWb = xlAp.Workbooks.Open(Files, , True)
        Set rng = xlWb.Worksheets( 1 ).UsedRange
        rng.Copy
        NewSheet.Paste Destination:=NewSheet.Range("A" & n)
        n = NewSheet.UsedRange.Rows.Count +  1 
        ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Range("A" & n)
        Application.CutCopyMode = False
        xlWb.Close
     Next
    Else
     MsgBox ("Не найдены файлы")
    End If
End With
Set xlWb = Nothing
Set rng = Nothing
Set NewSheet = Nothing
Set oShell = Nothing
End Sub
...
Рейтинг: 0 / 0
10.03.2006, 14:25:27
| Ответить | Цитировать | Написать  
Повторить операцию
    #33592849
Loll
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Loll
Гость
Вообще-то мне нужно 2 типа данных обрабатывать: в одном случае должно попадать на каждый лист, в другом подряд на один.
Поэтому должно быть 2 разных кода
ЗЫ А как исключить из поиска Application.FileSearch файл с определенным именем?
...
Рейтинг: 0 / 0
10.03.2006, 14:33:25
| Ответить | Цитировать | Написать  
Повторить операцию
    #33593059
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
Loll
ЗЫ А как исключить из поиска Application.FileSearch файл с определенным именем?
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
Sub Теcт()
Dim xlAp As New Excel.Application
Dim xlWb As Excel.Workbook
Dim rng As Range
Dim n As Long
n =  1 
Set oShell = CreateObject("Shell.Application")
Set NewSheet = ActiveWorkbook.ActiveSheet
With Application.FileSearch
    .LookIn = oShell.BrowseForFolder( 0 , "Выберите папку с заказом",  0 )
    .Filename = "*.xls"
    If .Execute >  0  Then
     For i =  1  To .FoundFiles.Count
        Files = .FoundFiles(i)
        Set xlWb = xlAp.Workbooks.Open(Files, , True)
        If xlWb.Name <> "Книга.xls" Then
             Set rng = xlWb.Worksheets( 1 ).UsedRange
             rng.Copy
             NewSheet.Paste Destination:=NewSheet.Range("A" & n)
             n = NewSheet.UsedRange.Rows.Count +  1 
             ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Range("A" & n)
             Application.CutCopyMode = False
        End If
        xlWb.Close
     Next
    Else
     MsgBox ("Не найдены файлы")
    End If
End With
Set xlWb = Nothing
Set rng = Nothing
Set NewSheet = Nothing
Set oShell = Nothing
End Sub
...
Рейтинг: 0 / 0
10.03.2006, 15:25:41
| Ответить | Цитировать | Написать  
Повторить операцию
    #33596141
Loll
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Loll
Гость
Я слегка изменила код и получилось вот так
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
For i =  1  To .FoundFiles.Count
        Files = .FoundFiles(i)
        Set xlWb = xlAp.Workbooks.Open(Files, , True)
        Set rng = xlWb.Worksheets( 1 ).Rows("1:1") 'вот тут
        rng.Copy
        NewSheet.Paste Destination:=NewSheet.Range("A" & n)
        n = NewSheet.UsedRange.Rows.Count +  1 
        Application.CutCopyMode = False

Но там есть объединенные ячейки и все их содержимое при копировании оказывается в одной ячейке. Как скопировать нормально? А потом скопированное объединить с бОльшим количеством столбцов, но меньшим сторок.

авторты наверное хотел на разных страницах в одном листе так?

Нет. Я хотела информацию из каждого файла на отдельный лист книги. Только чтобы листы были последовательно.

ЗЫ Кстати вот это не работает
Код: plaintext
Application.CutCopyMode = False


ЗЫЫ Как здесь вставить несколько имен файлов?
Код: plaintext
If xlWb.Name <> "Книга.xls" Then
...
Рейтинг: 0 / 0
13.03.2006, 12:18:03
| Ответить | Цитировать | Написать  
Повторить операцию
    #33596178
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
по поводу листов попорядку.
добавь после
Код: plaintext
Set NewSheet = ActiveWorkbook.Sheets.Add

вот это
Код: plaintext
Sheets(NewSheet.Name).Move After:=Sheets(Sheets.Count)
...
Рейтинг: 0 / 0
13.03.2006, 12:27:28
| Ответить | Цитировать | Написать  
Повторить операцию
    #33596282
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
Loll
ЗЫ, ЗЫЫ а это что?
...
Рейтинг: 0 / 0
13.03.2006, 12:53:43
| Ответить | Цитировать | Написать  
Повторить операцию
    #33596284
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
LollЗЫ Кстати вот это не работает
Код: plaintext
Application.CutCopyMode = False
попробуй так
Код: plaintext
Application.CommandBars("Clipboard").Controls( 4 ).Execute
...
Рейтинг: 0 / 0
13.03.2006, 12:54:17
| Ответить | Цитировать | Написать  
Повторить операцию
    #33596303
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
LollЗЫЫ Как здесь вставить несколько имен файлов?
Код: plaintext
If xlWb.Name <> "Книга.xls" Then

Код: plaintext
1.
If xlWb.Name <> "Книга.xls" And xlWb.Name <> "Книга1.xls" And _
xlWb.Name <> "Книга2.xls" Then
...
Рейтинг: 0 / 0
13.03.2006, 12:57:09
| Ответить | Цитировать | Написать  
Повторить операцию
    #33596381
Loll
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Loll
Гость
Я не тот код вставила в сообщение вот этот
Код: plaintext
Application.CutCopyMode = False
Возможно и работает, я просто не знаею что он делает :)

А не работает у меня
Код: plaintext
Application.DisplayAlerts=False
"ЗЫ" это "PS" в русской раскладке, когда переключаться лень :)

А как насчет объединенных ячеек? Как с ними работать?
...
Рейтинг: 0 / 0
13.03.2006, 13:12:48
| Ответить | Цитировать | Написать  
Повторить операцию
    #33596658
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
Код: plaintext
Application.DisplayAlerts=False
наверняка работает
только скорей всего это относится к ЕХСЕL
так же как и
Код: plaintext
Application.CutCopyMode = False
которая должна очищать буфер обмена, ну что бы при закрытии не задавался вопрос типа "в буфере осталось содержимое..."
в данной ситуации обмен происходит между двумя приложениями поэтому идет через буфер виндовс и он выкидывает это сообщение.
(ну это в моём понимании)
так вот вроде работает
Код: plaintext
1.
Application.CommandBars("Clipboard").Visible = True
Application.CommandBars("Clipboard").Controls( 4 ).Execute
...
Рейтинг: 0 / 0
13.03.2006, 14:05:34
| Ответить | Цитировать | Написать  
Повторить операцию
    #33596697
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
LollНо там есть объединенные ячейки и все их содержимое при копировании оказывается в одной ячейке.
У меня копирует все обьединения вообщем все форматы
LollА потом скопированное объединить с большим количеством столбцов, но меньшим сторок.
Не понял уточни, желательно с примером.
...
Рейтинг: 0 / 0
13.03.2006, 14:15:04
| Ответить | Цитировать | Написать  
Повторить операцию
    #33597439
Loll
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Loll
Гость
В документе "X" на первом листе в диапазоне "A1:F2" есть некие данные. Мне их нужно перенести в другой документ но уже разместить в ином диапазоне. Информация из первого файла будет размещена в диапазоне "A1:M1", то бишь ровно в одну строку, все последующее должно копироваться и попадать в "An:Mn". Я бы могла тупо задать диапазоны, но они могут изменяться, а единым для всех будет ячейка A1 и все что с ней объеденено.
...
Рейтинг: 0 / 0
13.03.2006, 17:01:09
| Ответить | Цитировать | Написать  
Повторить операцию
    #33597532
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
LollВ документе "X" на первом листе в диапазоне "A1:F2" есть некие данные. Мне их нужно перенести в другой документ но уже разместить в ином диапазоне. Информация из первого файла будет размещена в диапазоне "A1:M1", то бишь ровно в одну строку, все последующее должно копироваться и попадать в "An:Mn". Я бы могла тупо задать диапазоны, но они могут изменяться, а единым для всех будет ячейка A1 и все что с ней объеденено.

"A1:F2" объединена в одну ячейку, или там несколько ячеек?
...
Рейтинг: 0 / 0
13.03.2006, 17:21:11
| Ответить | Цитировать | Написать  
Повторить операцию
    #33597619
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
        If xlWb.Name = "Книга3.xls" Then
            ActiveWorkbook.ActiveSheet.Range("A1:M1").Merge ' объединение ячеек
            ActiveWorkbook.ActiveSheet.Range("A1:M1").Value = _
                xlWb.Worksheets( 1 ).Range("A1").Value ' присвоение значения
        Else
            rng.Copy NewSheet.Range("A" & n & ":IV" & n)
            NewSheet.Paste Destination:=NewSheet.Range("A" & n)
        End If
...
Рейтинг: 0 / 0
13.03.2006, 17:41:06
| Ответить | Цитировать | Написать  
20 сообщений из 20, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Повторить операцию
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&msg=33592274&tid=2185130]:
 0ms
get settings:
 8ms
get forum list:
 14ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 48ms
get topic data:
 8ms
get forum data:
 2ms
get page messages:
 46ms
get tp. blocked users:
 1ms
others: 206ms
total:  337ms
созд. / загр.: 337ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]