Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Повторить операцию / 20 сообщений из 20, страница 1 из 1
10.03.2006, 11:45:40
    #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, 12:15:29
    #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:17:22
    #33592283
vkodor
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Повторить операцию
измени
Код: plaintext
Set rng = xlWb.Worksheets( 1 ).UsedRange
на
Код: plaintext
Set rng = xlWb.Worksheets( 3 ).UsedRange
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.03.2006, 13:13:25
    #33592558
Loll
Loll
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Повторить операцию
Все классно работает, только вот листы получаются перепутаны :( Мне нужно чтобы первый лист был пустым, а остальные по порядку как файлы в папке.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.03.2006, 13:16:24
    #33592565
Loll
Loll
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Повторить операцию
И если не трудно еще подскажите как сделать не на разных листах, а на одном по порядку?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.03.2006, 13:54:38
    #33592715
vkodor
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Повторить операцию
Lollи чтобы копии из файлов помещались на разные листы.
Loll
если не трудно еще подскажите как сделать не на разных листах, а на одном по порядку?
ты уж определись.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.03.2006, 14:25:27
    #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:33:25
    #33592849
Loll
Loll
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Повторить операцию
Вообще-то мне нужно 2 типа данных обрабатывать: в одном случае должно попадать на каждый лист, в другом подряд на один.
Поэтому должно быть 2 разных кода
ЗЫ А как исключить из поиска Application.FileSearch файл с определенным именем?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.03.2006, 15:25:41
    #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
| Ответить | Цитировать | Написать  
13.03.2006, 12:18:03
    #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:27:28
    #33596178
vkodor
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Повторить операцию
по поводу листов попорядку.
добавь после
Код: plaintext
Set NewSheet = ActiveWorkbook.Sheets.Add

вот это
Код: plaintext
Sheets(NewSheet.Name).Move After:=Sheets(Sheets.Count)
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
13.03.2006, 12:53:43
    #33596282
vkodor
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Повторить операцию
Loll
ЗЫ, ЗЫЫ а это что?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
13.03.2006, 12:54:17
    #33596284
vkodor
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Повторить операцию
LollЗЫ Кстати вот это не работает
Код: plaintext
Application.CutCopyMode = False
попробуй так
Код: plaintext
Application.CommandBars("Clipboard").Controls( 4 ).Execute
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
13.03.2006, 12:57:09
    #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, 13:12:48
    #33596381
Loll
Loll
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Повторить операцию
Я не тот код вставила в сообщение вот этот
Код: plaintext
Application.CutCopyMode = False
Возможно и работает, я просто не знаею что он делает :)

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

А как насчет объединенных ячеек? Как с ними работать?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
13.03.2006, 14:05:34
    #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:15:04
    #33596697
vkodor
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Повторить операцию
LollНо там есть объединенные ячейки и все их содержимое при копировании оказывается в одной ячейке.
У меня копирует все обьединения вообщем все форматы
LollА потом скопированное объединить с большим количеством столбцов, но меньшим сторок.
Не понял уточни, желательно с примером.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
13.03.2006, 17:01:09
    #33597439
Loll
Loll
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Повторить операцию
В документе "X" на первом листе в диапазоне "A1:F2" есть некие данные. Мне их нужно перенести в другой документ но уже разместить в ином диапазоне. Информация из первого файла будет размещена в диапазоне "A1:M1", то бишь ровно в одну строку, все последующее должно копироваться и попадать в "An:Mn". Я бы могла тупо задать диапазоны, но они могут изменяться, а единым для всех будет ячейка A1 и все что с ней объеденено.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
13.03.2006, 17:21:11
    #33597532
vkodor
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Повторить операцию
LollВ документе "X" на первом листе в диапазоне "A1:F2" есть некие данные. Мне их нужно перенести в другой документ но уже разместить в ином диапазоне. Информация из первого файла будет размещена в диапазоне "A1:M1", то бишь ровно в одну строку, все последующее должно копироваться и попадать в "An:Mn". Я бы могла тупо задать диапазоны, но они могут изменяться, а единым для всех будет ячейка A1 и все что с ней объеденено.

"A1:F2" объединена в одну ячейку, или там несколько ячеек?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
13.03.2006, 17:41:06
    #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
| Ответить | Цитировать | Написать  
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Повторить операцию / 20 сообщений из 20, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 309ms
Закрыть
start [/forum/topic.php?fid=61&tablet=1&tid=2185130]:
 0ms
get settings:
 6ms
get forum list:
 10ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 56ms
get topic data:
 7ms
get forum data:
 2ms
get page messages:
 33ms
get tp. blocked users:
 1ms
others: 190ms
total:  309ms
x
x
Закрыть


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