|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
|
Опции темы | Поиск в этой теме |
28.03.2012, 17:21 | #11 |
Пользователь
Регистрация: 27.02.2012
Сообщений: 20
|
Подскажите, пожалуйста, как избавиться от создания двух книг(с шапкой и без шапки)? Необходимо создание книги в конкретной папке и с конкретной шапкой, которая должна переносится вместе со строчками 102 кода. Как это исправить?
Sub Perenos() Dim x As Range, rr As Range: Application.ScreenUpdating = False Set x = [E:E].Find(102, , , xlWhole) If Not x Is Nothing Then [E:E].ColumnDifferences(x).EntireRow.Hid den = True Set rr = ActiveSheet.UsedRange.SpecialCells( xlCellTypeVisible).EntireRow Rows.Hidden = False rr.Copy Workbooks.Add.Sheets(1).[a1] Dim sh As Worksheet Set sh = Workbooks.Add.Sheets(1) sh.[a1] = "Ïåðâàÿ ÿ÷åéêà øàïêè" rr.Copy sh.[a2] rr.Delete End If End Sub |
02.04.2012, 14:59 | #12 |
Пользователь
Регистрация: 27.02.2012
Сообщений: 20
|
Подскажите пожалуйста, как исправить:
Мне нужно чтобы перенос сточек со 102 кодом переносился в новую книгу со 2-ой строки, а на первую вставала шапка. Dim x As Range, rr As Range: Application.ScreenUpdating = False Set x = [E:E].Find(102, , , xlWhole) If Not x Is Nothing Then [E:E].ColumnDifferences(x).EntireRow.Hid den = True Set rr = ActiveSheet.UsedRange.SpecialCells( xlCellTypeVisible).EntireRow Rows.Hidden = False Dim sh As Worksheet Set sh = Workbooks.Add.Sheets(1) sh.[a1] = "Сотрудник" sh.[b1] = "Год" sh.[c1] = "месяц регистрации" sh.[d1] = "месяц действия" sh.[e1] = "вид расчёта" sh.[f1] = "сумма" rr.Copy Workbooks.Add.Sheets(1).[a2] rr.Delete End If У меня создаётся одна книга - без шапки. и вторая книга - одна шапка. Подскажите пожалуйста как объединить? |
02.04.2012, 15:57 | #13 |
Старожил
Регистрация: 11.05.2010
Сообщений: 5,166
|
Извините, совсем забыл про тему... Но Вы и сами почти сделали, осталась мелочь
rr.Copy sh.[a2] Код:
webmoney: E265281470651 Z422237915069 R418926282008
|
02.04.2012, 16:33 | #14 |
Пользователь
Регистрация: 27.02.2012
Сообщений: 20
|
Спасибо. А подскажите как мне задать, чтобы эта книга сохранялась сама в указанной папке и с названием:
Sub Perenos() Dim WBk As Workbook Dim Путь к папке As String Dim WSheet As Worksheet Dim Путь к файлу As String Dim WBN As Workbook Dim WSh As Worksheet Dim x As Range, rr As Range: Application.ScreenUpdating = False Set x = [E:E].Find(102, , , xlWhole) If Not x Is Nothing Then [E:E].ColumnDifferences(x).EntireRow.Hid den = True Set rr = ActiveSheet.UsedRange.SpecialCells( xlCellTypeVisible).EntireRow Rows.Hidden = False Dim sh As Worksheet Set sh = Workbooks.Add.Sheets(1) sh.[a1] = "Сотрудник" sh.[b1] = "Год" sh.[c1] = "месяц регистрации" sh.[d1] = "месяц действия" sh.[e1] = "вид расчёта" sh.[f1] = "сумма" rr.Copy sh.[a2] rr.Delete End If Set WBk = ThisWorkbook Путь к папке = WBk.Path & "\DBF1\" On Error Resume Next: MkDir Путь к папке Путь к файлу = Путь к папке & "Сдельная" & WSheet.Range("J1") & WSheet.Range("K1") & ".xls" Set WBN = Workbooks.Add(xlWBATWorksheet) Set WSh = WBN.Worksheets(1) WSh.Name = "Swod1" WBN.SaveAs FileName:=Путь к файлу, FileFormat:=xlNormal, CreateBackup:=False WBN.Close SaveChanges:=True End Sub Папка DBF1 уже создана, и в неё записывается файл с остальными кодами. А этот лист несохраняется((( |
02.04.2012, 16:40 | #15 |
Старожил
Регистрация: 11.05.2010
Сообщений: 5,166
|
Попробуйте
Код:
Ну и закрыть в конце Код:
А sh.parent - это будет сама эта книга (т.к. она явно нигде не прописана в ссылке). Можно было сделать иначе (я обычно так делаю) - задаём ссылку на новую книгу, потом ссылку на нужный лист этой книги. Далее работаем уже без Parent, т.к. есть прямые ссылки на оба объекта.
webmoney: E265281470651 Z422237915069 R418926282008
Последний раз редактировалось Hugo121; 02.04.2012 в 16:45. |
02.04.2012, 17:15 | #16 |
Пользователь
Регистрация: 27.02.2012
Сообщений: 20
|
ПутьКПапке = WBk.Path & "\DBF1\"
On Error Resume Next: MkDir ПутьКПапке ПутьКФайлу = ПутьКПапке & "Сдельная" & WSheet.Range("J1") & WSheet.Range("K1") & ".xls" sh.Parent.SaveAs FileName:=ПутьКФайлу, FileFormat:=xlNormal, CreateBackup:=False sh.Parent.Close 0 Похоже не видит папку DBF1. Ругается на первую строчку. Что нужно ещё указать? |
02.04.2012, 17:45 | #17 |
Старожил
Регистрация: 11.05.2010
Сообщений: 5,166
|
Трудно сказать без примера в файле.
У меня есть такой пример кода (у Вас в общем аналогично): Код:
webmoney: E265281470651 Z422237915069 R418926282008
|
03.04.2012, 07:15 | #18 |
Пользователь
Регистрация: 27.02.2012
Сообщений: 20
|
Посмотрите пожалуйста , как в моём случае сделано. что не правильно?
|
03.04.2012, 11:16 | #19 |
Старожил
Регистрация: 11.05.2010
Сообщений: 5,166
|
Забыли в Sub Perenos() одну строку в начале добавить:
Set WBk = ThisWorkbook Хотя можно задать эту переменную публичной, и тогда хватает её задать в первом коде. А так вроде всё работает. Если проходить пошагово, то видно, что ПутьКПапке = WBk.Path & "\DBF1\" не формирется вообще, т.к. срабатывает On Error Resume Next из верхнего кода (это нужно отключать, когда более не требуется).
webmoney: E265281470651 Z422237915069 R418926282008
|
03.04.2012, 13:38 | #20 |
Пользователь
Регистрация: 27.02.2012
Сообщений: 20
|
Файл в папке DBF1 только один создаётся - Сетевая, а файл - Сдельная не создаётся. и никаких предупреждений не пишет. Почему?
|
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
добавить символ в каждую запись в столбце | andrei186 | SQL, базы данных | 2 | 28.10.2011 13:23 |
Цикл, запись результат в ячейки | bruce_lee | Microsoft Office Excel | 4 | 06.10.2010 16:08 |
последняя запись в столбце | ALEKS2008 | Microsoft Office Excel | 3 | 18.06.2010 13:29 |