Гость
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Пересохранение книги под другим именем / 9 сообщений из 9, страница 1 из 1
03.05.2012, 15:23
    #37780660
Takayavot
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пересохранение книги под другим именем
Добрый день!
Пытаюсь выполнить вот какой макрос.
В некой папке есть некоторое кол-во книг, которые нужно
1 открыть,
2 изменить и
3 пересохранить под другим именем (с приставкой) в другой папке.

Вот макрос (упрощенный)

'1 открытие книги

Dim WB As Workbook
Path = "C:\DSS\test\"
If Dir(Path, vbDirectory) = "" Then
MsgBox "Путь не найден"
Exit Sub
End If
IFILENAME = Dir(Path & "*.xls")
Do While IFILENAME <> ""
iCount = iCount + 1
Set WB = Workbooks.Open(Filename:=Path & IFILENAME, ReadOnly:=True)


‘2 изменение книги
Worksheets(1).Name = "Value"
Worksheets(2).Name = "Volume"
Worksheets(3).Name = "Items»

‘3 пересохранение книги под другим именем в другой папке
Path2 = "C:\DSS\test\Processed\"
Ifilename2 = Split(ThisWorkbook.Name, ".")(0) & " processed.xls"
Workbooks(IFILENAME).Activate
ActiveWorkbook.SaveAs Filename:= _
Path2 & Ifilename2

IFILENAME = Dir
Loop
If iCount = 0 Then MsgBox "Файлов не обнаружено", 64, ""
End Sub


Проблема в том, что сохраняет он не ту книгу, которую открывает из папки c:\dss\test
а саму книгу с макросом. (Макрос запускается из отдельной книги).

Погите советом!
спасибо.
...
Рейтинг: 0 / 0
03.05.2012, 15:28
    #37780669
Antonariy
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пересохранение книги под другим именем
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
'2 изменение книги
WB.Worksheets(1).Name = "Value"
WB.Worksheets(2).Name = "Volume"
WB.Worksheets(3).Name = "Items»

'3 пересохранение книги под другим именем в другой папке 
Path2 = "C:\DSS\test\Processed\"
Ifilename2 = Split(ThisWorkbook.Name, ".")(0) & " processed.xls"
WB.SaveAs Path2 & Ifilename2
WB.Close
...
Рейтинг: 0 / 0
03.05.2012, 15:47
    #37780714
Takayavot
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пересохранение книги под другим именем
Antonariy,
неа, не получается.
Все равно пересохраняет именно книгу с макросом, а не те, что в папке test
...
Рейтинг: 0 / 0
03.05.2012, 15:50
    #37780718
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пересохранение книги под другим именем
Takayavotнеа, не получается.Не может быть, приведите полностью получившийся макрос (с изменениями Antonariy)

(и не забывайте оформлять код тэгами)
...
Рейтинг: 0 / 0
03.05.2012, 16:08
    #37780751
Takayavot
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пересохранение книги под другим именем
Shocker.ProНе может быть, приведите полностью получившийся макрос (с изменениями Antonariy)
(и не забывайте оформлять код тэгами)

Sub TotalMacro()
Dim WB As Workbook

Path = "C:\DSS\Dashboard\TOI + WIP\Single Cities\"

If Dir(Path, vbDirectory) = "" Then
MsgBox "Ïóòü íå íàéäåí"
Exit Sub
End If
IFILENAME = Dir(Path & "*.xls")


Do While IFILENAME <> ""
iCount = iCount + 1
Set WB = Workbooks.Open(Filename:=Path & IFILENAME, ReadOnly:=True)

Application.DisplayAlerts = False
WB.Sheets(1).Delete
Application.DisplayAlerts = True
WB.Worksheets(1).Name = "Value"
WB.Worksheets(2).Name = "Volume"
WB.Worksheets(3).Name = "Items"
WB.Worksheets(4).Name = "Price"
WB.Worksheets(5).Name = "Dist"





Path2 = "C:\DSS\Dashboard\TOI + WIP\Single Cities\Processed\"
Ifilename2 = Split(ThisWorkbook.Name, ".")(0) & " processed.xls"
WB.SaveAs Path2 & Ifilename2
WB.Close



Пути немного изменены, но, думаю, не суть.
...
Рейтинг: 0 / 0
03.05.2012, 16:10
    #37780760
Takayavot
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пересохранение книги под другим именем
Конец цикла потеряла
вот

IFILENAME = Dir
Loop
If iCount = 0 Then MsgBox "Ôàéëîâ íå îáíàðóæåíî", 64, ""

End Sub
...
Рейтинг: 0 / 0
03.05.2012, 16:14
    #37780772
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пересохранение книги под другим именем
Shocker.Pro(и не забывайте оформлять код тэгами)надо же, я забыл сказать: оформляйте тэгами ДЛЯ КОДА

Код: vbnet
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.
34.
35.
Sub TotalMacro()
Dim WB As Workbook

Path = "C:\DSS\Dashboard\TOI + WIP\Single Cities\"

If Dir(Path, vbDirectory) = "" Then
MsgBox "&#207;&#243;&#242;&#252; &#237;&#229; &#237;&#224;&#233;&#228;&#229;&#237;"
Exit Sub
End If
IFILENAME = Dir(Path & "*.xls")


Do While IFILENAME <> ""
iCount = iCount + 1
Set WB = Workbooks.Open(Filename:=Path & IFILENAME, ReadOnly:=True)

Application.DisplayAlerts = False
WB.Sheets(1).Delete
Application.DisplayAlerts = True
WB.Worksheets(1).Name = "Value"
WB.Worksheets(2).Name = "Volume"
WB.Worksheets(3).Name = "Items"
WB.Worksheets(4).Name = "Price"
WB.Worksheets(5).Name = "Dist"

Path2 = "C:\DSS\Dashboard\TOI + WIP\Single Cities\Processed\"
Ifilename2 = Split(ThisWorkbook.Name, ".")(0) & " processed.xls"
WB.SaveAs Path2 & Ifilename2
WB.Close

IFILENAME = Dir
Loop
If iCount = 0 Then MsgBox "&#212;&#224;&#233;&#235;&#238;&#226; &#237;&#229; &#238;&#225;&#237;&#224;&#240;&#243;&#230;&#229;&#237;&#238;", 64, ""

End Sub
...
Рейтинг: 0 / 0
03.05.2012, 16:31
    #37780818
Takayavot
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пересохранение книги под другим именем
Shocker.Proнадо же, я забыл сказать: оформляйте тэгами ДЛЯ КОДА


ой, сразу не сообразила что src - это для кода ) буду знать, извиняюсь )
Скопировала ваш макрос один в один.
Все равно предлагает сохранить сам себя с приставкой processed.
...
Рейтинг: 0 / 0
03.05.2012, 16:50
    #37780875
Takayavot
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Пересохранение книги под другим именем
Ура-Ура-Ура!
Я нашла ошибку!
Ifilename2 = Split(WB.Name, ".")(0) & " processed.xls"
вместо
Ifilename2 = Split(thisworkbook.Name, ".")(0) & " processed.xls"

Спасибо всем пребольшое!
...
Рейтинг: 0 / 0
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Пересохранение книги под другим именем / 9 сообщений из 9, страница 1 из 1
Целевая тема:
Создать новую тему:
Автор:
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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