ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Уважаемые форумчане, проблема VBA excel
15 сообщений из 15, страница 1 из 1
Уважаемые форумчане, проблема VBA excel
    #37697974
astory
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
astory
Гость
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
Sub DivFile()
    Dim i As Long, s As String, ws As Worksheet
    Application.ScreenUpdating = False: Set ws = ActiveSheet
    For i = 1 To ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1 Step 46
        Workbooks.Add xlWBATWorksheet: ws.Rows(i & ":" & i + 45).Copy [A1]
        s = Replace(ThisWorkbook.FullName, ".xls", "-" & (Fix(i / 46) + 1) & ".xls")
        ActiveWorkbook.SaveAs s: ActiveWorkbook.Close
    Next
End Sub



Необходимо сохранить форматирование, как на исходнике!!! ВЫРУЧАЙТЕ!
...
Рейтинг: 0 / 0
10.03.2012, 18:57
| Ответить | Цитировать | Написать  
Уважаемые форумчане, проблема VBA excel
    #37697979
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
А проблема-то где?
...
Рейтинг: 0 / 0
10.03.2012, 19:01
| Ответить | Цитировать | Написать  
Уважаемые форумчане, проблема VBA excel
    #37697986
astory
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
astory
Гость
Shocker.Pro,

Проблема в том, что при разбиении на новые файлы форматирование пропадает, то есть ширина строк и столбцов не переходит с исходника) я не программист, я любитель, надеялся что Вы мне подскажете где проблема)
...
Рейтинг: 0 / 0
10.03.2012, 19:06
| Ответить | Цитировать | Написать  
Уважаемые форумчане, проблема VBA excel
    #37697990
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
Подскажем, только надо было не забыть ее озвучить... ща поэкспериментирую
...
Рейтинг: 0 / 0
10.03.2012, 19:08
| Ответить | Цитировать | Написать  
Уважаемые форумчане, проблема VBA excel
    #37697992
astory
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
astory
Гость
Shocker.Pro,

Буду премного благодарен Вам)
...
Рейтинг: 0 / 0
10.03.2012, 19:09
| Ответить | Цитировать | Написать  
Уважаемые форумчане, проблема VBA excel
    #37697998
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
Для начала тут вообще неправильный подход - у меня книга копируется сама в себя... не стоит работать с ActiveWorkbook почти никогда.

При копировании строк высота строк у мня копируется, не копируется только ширина столбцов. Сколько столбцов, ширину которых надо скопировать?
...
Рейтинг: 0 / 0
10.03.2012, 19:16
| Ответить | Цитировать | Написать  
Уважаемые форумчане, проблема VBA excel
    #37698006
astory
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
astory
Гость
Shocker.Pro,

14 столбцов. Мне подсказали этот код, в результате выходит все то что мне надо, за исключением, ширины столбцов)
...
Рейтинг: 0 / 0
10.03.2012, 19:23
| Ответить | Цитировать | Написать  
Уважаемые форумчане, проблема VBA excel
    #37698016
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
astoryМне подсказали этот кодСкажите тому, кто подсказал этот код, чтобы забыл про ActiveWorkbook. Может в каких-то версиях это работает, у меня - нет. А также, не забывал вернуть Application.ScreenUpdating на место, а то будет очень весело.

Переделал код универсально и добавил изменение ширины столбцов
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
Sub DivFile()
    
    Dim i As Long, j As Integer, s As String, ws As Worksheet, NewWB As Workbook
    Application.ScreenUpdating = False
    Set ws = ActiveSheet
    For i = 1 To ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1 Step 46
        Set NewWB = Workbooks.Add(xlWBATWorksheet)
        ws.Rows(i & ":" & i + 45).Copy NewWB.Worksheets(1).Range("A1")
        For j = 1 To 14
          NewWB.Worksheets(1).Columns(j).ColumnWidth = ws.Columns(j).ColumnWidth
        Next
        s = Replace(ThisWorkbook.FullName, ".xls", "-" & (Fix(i / 46) + 1) & ".xls")
        NewWB.SaveAs s
        NewWB.Close
        Set NewWB = Nothing
    Next
    Application.ScreenUpdating = True
    
End Sub
...
Рейтинг: 0 / 0
10.03.2012, 19:32
| Ответить | Цитировать | Написать  
Уважаемые форумчане, проблема VBA excel
    #37698020
astory
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
astory
Гость
Shocker.Pro,

Благодарю Вас, в течение получаса проверю)
...
Рейтинг: 0 / 0
10.03.2012, 19:37
| Ответить | Цитировать | Написать  
Уважаемые форумчане, проблема VBA excel
    #37698025
astory
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
astory
Гость
astory,

Спасибо огромное, очень выручили, и если есть возможнось подскажите как сделать чтобы он присваивал имена файлам, такие же как значения первой ячейки каждого файла, если конечно это реально, заранее спасибо)
...
Рейтинг: 0 / 0
10.03.2012, 19:48
| Ответить | Цитировать | Написать  
Уважаемые форумчане, проблема VBA excel
    #37698037
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
катастрофа
Участник
astoryastory,
чтобы он присваивал имена файлам, такие же как значения первой ячейки каждого файла, если конечно это реально, заранее спасибо)
собака зарыта в том числе здесь
Код: vbnet
1.
2.
s = Replace(ThisWorkbook.FullName, ".xls", "-" & (Fix(i / 46) + 1) & ".xls")
        NewWB.SaveAs s
...
Рейтинг: 0 / 0
10.03.2012, 19:58
| Ответить | Цитировать | Написать  
Уважаемые форумчане, проблема VBA excel
    #37698041
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
замените строку
s = ...
на
Код: vbnet
1.
s = ThisWorkbook.Path + Application.PathSeparator + NewWB.Worksheets(1).Range("A1").Text + ".xls"


но помните, ячейка не должна содержать символов, недопустимых в имени файла
...
Рейтинг: 0 / 0
10.03.2012, 20:04
| Ответить | Цитировать | Написать  
Уважаемые форумчане, проблема VBA excel
    #37698042
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
 
катастрофасобака зарыта в том числе здесь
Эндрю, я ходатайствовал перед Дюком за разбанивание тебя, однако ты уже хочешь заставить меня пожалеть о своем поступке.
...
Рейтинг: 0 / 0
10.03.2012, 20:05
| Ответить | Цитировать | Написать  
Уважаемые форумчане, проблема VBA excel
    #37698049
катастрофа
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
катастрофа
Участник
[quot Shocker.Pro]катастрофасобака зарыта в том числе здесь
и зачем же Вы указали о её замене?
...
Рейтинг: 0 / 0
10.03.2012, 20:10
| Ответить | Цитировать | Написать  
Уважаемые форумчане, проблема VBA excel
    #37698089
astory
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
astory
Гость
Shocker.Pro,

Спасибо ОГРОМНЕЙШЕЕ Вам) Выручили нереально, сэкономили кучу моего времени! Еще раз СПАСИБО!
...
Рейтинг: 0 / 0
10.03.2012, 21:09
| Ответить | Цитировать | Написать  
15 сообщений из 15, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Уважаемые форумчане, проблема VBA excel
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&fpage=106&tid=2175923]:
 0ms
get settings:
 9ms
get forum list:
 14ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 53ms
get topic data:
 17ms
get forum data:
 3ms
get page messages:
 55ms
get tp. blocked users:
 1ms
others: 236ms
total:  394ms
созд. / загр.: 394ms
x
x
Закрыть


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