Добрый день! Попытаюсь описать задачу понятно. Имею экселевский файл с списком рекламы 28.03.2015.xls. В колонке название блока указан номер блока. Необходимо чтобы скрипт создал тестовый файл с именем номера блока взятого из колонки с номером блока и расширением .air, далее в файле вставлял в этот файл в первую строку строчку "comment 0 " без кавычек и номер блока, а далее брал ID ролика и в каждую строку добавляя перед ID "movie 0:00:00.00 R:", а после ID добавлял ".avi", чтоб получилось так :
comment 0 1 movie 0:00:00.00 R:437585.avi movie 0:00:00.00 R:491517.avi movie 0:00:00.00 R:700948039.avi
и так с каждым блоком новый файл. В файле 40 блоков и должно получиться 40 текстовых файлов с расширением .air Подскажите можно это скриптом реализовать? 1.rar прилагаю с иходником Exel 28.03.2015.xls и результат как должно получиться 01-РЕК.air
Добрый день! Попытаюсь описать задачу понятно. Имею экселевский файл с списком рекламы 28.03.2015.xls. В колонке название блока указан номер блока. Необходимо чтобы скрипт создал тестовый файл с именем номера блока взятого из колонки с номером блока и расширением .air, далее в файле вставлял в этот файл в первую строку строчку "comment 0 " без кавычек и номер блока, а далее брал ID ролика и в каждую строку добавляя перед ID "movie 0:00:00.00 R:", а после ID добавлял ".avi", чтоб получилось так :
comment 0 1 movie 0:00:00.00 R:437585.avi movie 0:00:00.00 R:491517.avi movie 0:00:00.00 R:700948039.avi
и так с каждым блоком новый файл. В файле 40 блоков и должно получиться 40 текстовых файлов с расширением .air Подскажите можно это скриптом реализовать? 1.rar прилагаю с иходником Exel 28.03.2015.xls и результат как должно получиться 01-РЕК.aird22cva
1). Важно ли наличие ноля перед цифрой номера блока, если номер блока меньше 10-ти? 2). Должен ли быть дефис в имени? 3). Должна ли стоять "РЕК" в названии файла? На каком языке?
1). Важно ли наличие ноля перед цифрой номера блока, если номер блока меньше 10-ти? 2). Должен ли быть дефис в имени? 3). Должна ли стоять "РЕК" в названии файла? На каком языке?Rioran
Роман, Москва, voronov_rv@mail.ru Яндекс-Деньги: 41001312674279
Цитата d22cva, 31.03.2015 в 09:36, в сообщении № 1 тестовый файл с именем номера блока
Цитата d22cva, 31.03.2015 в 09:36, в сообщении № 1 результат как должно получиться 01-РЕК.air
1). Важно ли наличие ноля перед цифрой номера блока, если номер блока меньше 10-ти? 2). Должен ли быть дефис в имени? 3). Должна ли стоять "РЕК" в названии файла? На каком языке?
Результирующий файл должен содержать в имени файла хотя бы номер блока, все остальное не обязательно.Пример, 1.air 1) Полем вы подразумеваете 0, то есть 01? Если да то это не имеет значения, отлично будет если будет просто 1. 2) Дефис не обязателен , можно вообще без него 3) Рек тоже не обязательно, если давать его то можно на английском
Цитата d22cva, 31.03.2015 в 09:36, в сообщении № 1 тестовый файл с именем номера блока
Цитата d22cva, 31.03.2015 в 09:36, в сообщении № 1 результат как должно получиться 01-РЕК.air
1). Важно ли наличие ноля перед цифрой номера блока, если номер блока меньше 10-ти? 2). Должен ли быть дефис в имени? 3). Должна ли стоять "РЕК" в названии файла? На каком языке?
Результирующий файл должен содержать в имени файла хотя бы номер блока, все остальное не обязательно.Пример, 1.air 1) Полем вы подразумеваете 0, то есть 01? Если да то это не имеет значения, отлично будет если будет просто 1. 2) Дефис не обязателен , можно вообще без него 3) Рек тоже не обязательно, если давать его то можно на английскомd22cva
d22cva, приглашаю протестировать, файл с кнопкой во вложении.
Сохраните файл в новой папке в любом месте на компьютере. Откройте файл, разрешите макросы. По нажатию кнопки в папке с файлом будут созданы текстовые файлы.
[vba]
Код
Sub Print_Airs()
'Author: Roman "Rioran" Voronov 'Date: the 31-st of March, 2015 'Feedback: voronov_rv@mail.ru
'Программа для составления .air файлов в той же папке, где сохранена эта книга Excel
Dim sPath As String Dim PS As String
Dim Check As Boolean Dim Block As String Dim StrX As String Dim RowX As Long Dim i&, j&, k&
PS = Application.PathSeparator
sPath = ThisWorkbook.Path If Right(sPath, 1) <> PS Then sPath = sPath & PS
RowX = Cells(Rows.Count, 1).End(xlUp).Row
For i = 5 To RowX Block = Cells(i, 1).Value If Block <> "" Then StrX = "comment 0 " & Block Do While Cells(i, 4).Value <> 0 StrX = StrX & vbNewLine & "movie 0:00:00.00 R:" & Cells(i, 4).Value & ".avi" i = i + 1 Loop Check = SaveTXTfile(sPath & Block & "-PEK.air", StrX) End If Next i
MsgBox "Done"
End Function
Function SaveTXTfile(ByVal filename As String, ByVal txt As String) As Boolean 'Функция сохранения файла, спасибо => http://excelvba.ru/code/txt
Dim fso, ts
On Error Resume Next Err.Clear
Set fso = CreateObject("scripting.filesystemobject") Set ts = fso.CreateTextFile(filename, True) ts.Write txt ts.Close SaveTXTfile = Err = 0
Set ts = Nothing Set fso = Nothing End Function
[/vba]
d22cva, приглашаю протестировать, файл с кнопкой во вложении.
Сохраните файл в новой папке в любом месте на компьютере. Откройте файл, разрешите макросы. По нажатию кнопки в папке с файлом будут созданы текстовые файлы.
[vba]
Код
Sub Print_Airs()
'Author: Roman "Rioran" Voronov 'Date: the 31-st of March, 2015 'Feedback: voronov_rv@mail.ru
'Программа для составления .air файлов в той же папке, где сохранена эта книга Excel
Dim sPath As String Dim PS As String
Dim Check As Boolean Dim Block As String Dim StrX As String Dim RowX As Long Dim i&, j&, k&
PS = Application.PathSeparator
sPath = ThisWorkbook.Path If Right(sPath, 1) <> PS Then sPath = sPath & PS
RowX = Cells(Rows.Count, 1).End(xlUp).Row
For i = 5 To RowX Block = Cells(i, 1).Value If Block <> "" Then StrX = "comment 0 " & Block Do While Cells(i, 4).Value <> 0 StrX = StrX & vbNewLine & "movie 0:00:00.00 R:" & Cells(i, 4).Value & ".avi" i = i + 1 Loop Check = SaveTXTfile(sPath & Block & "-PEK.air", StrX) End If Next i
MsgBox "Done"
End Function
Function SaveTXTfile(ByVal filename As String, ByVal txt As String) As Boolean 'Функция сохранения файла, спасибо => http://excelvba.ru/code/txt
Dim fso, ts
On Error Resume Next Err.Clear
Set fso = CreateObject("scripting.filesystemobject") Set ts = fso.CreateTextFile(filename, True) ts.Write txt ts.Close SaveTXTfile = Err = 0
Rioran, KuklP, Благодарю! А как сделать чтоб рядом с экселевским файлом создавалась папка и в ней уже создавались все мои файлы? А папке присуждалось бы имя из ячейки А2 с 9 по 18 символ, т.е. там текст "на дату 28.03.2015 бла бла бла бла" , а папка бы создавалась с именем 28.03.2015?
Rioran, KuklP, Благодарю! А как сделать чтоб рядом с экселевским файлом создавалась папка и в ней уже создавались все мои файлы? А папке присуждалось бы имя из ячейки А2 с 9 по 18 символ, т.е. там текст "на дату 28.03.2015 бла бла бла бла" , а папка бы создавалась с именем 28.03.2015?d22cva
For i = 5 To RowX Block = Cells(i, 1).Value If Block <> "" Then StrX = "comment 0 " & Block Do While Cells(i, 4).Value <> 0 StrX = StrX & vbNewLine & "movie 0:00:00.00 R:" & Cells(i, 4).Value & ".avi" i = i + 1 Loop Check = SaveTXTfile(sPath & PS & Block & "-PEK.air", StrX) End If Next i
MsgBox "Done"
End Sub
[/vba]
[vba]
Код
Sub Print_Airs()
'Author: Roman "Rioran" Voronov 'Date: the 31-st of March, 2015 'Feedback: voronov_rv@mail.ru
Dim sPath As String Dim PS As String
Dim Check As Boolean Dim Block As String Dim StrX As String Dim RowX As Long Dim i&, j&, k&
For i = 5 To RowX Block = Cells(i, 1).Value If Block <> "" Then StrX = "comment 0 " & Block Do While Cells(i, 4).Value <> 0 StrX = StrX & vbNewLine & "movie 0:00:00.00 R:" & Cells(i, 4).Value & ".avi" i = i + 1 Loop Check = SaveTXTfile(sPath & PS & Block & "-PEK.air", StrX) End If Next i
For i = 5 To RowX Block = Cells(i, 1).Value If Block <> "" Then StrX = "comment 0 " & Block Do While Cells(i, 4).Value <> 0 StrX = StrX & vbNewLine & "movie 0:00:00.00 R:" & Cells(i, 4).Value & ".avi" i = i + 1 Loop Check = SaveTXTfile(sFolder & Block & "-PEK.air", StrX) End If Next i
MsgBox "Done"
End Sub
Function SaveTXTfile(ByVal filename As String, ByVal txt As String) As Boolean 'Функция сохранения файла, спасибо => http://excelvba.ru/code/txt
Dim fso, ts
On Error Resume Next Err.Clear
Set fso = CreateObject("scripting.filesystemobject") Set ts = fso.CreateTextFile(filename, True) ts.Write txt ts.Close SaveTXTfile = Err = 0
Set ts = Nothing Set fso = Nothing End Function
[/vba]
d22cva, исправил опечатку, добавил создание папки:
[vba]
Код
Sub Print_Airs()
'Author: Roman "Rioran" Voronov 'Date: the 31-st of March, 2015 'Feedback: voronov_rv@mail.ru
'Программа для составления .air файлов в той же папке, где сохранена эта книга Excel
Dim sFolder As String Dim sPath As String Dim PS As String
Dim Check As Boolean Dim Block As String Dim StrX As String Dim RowX As Long Dim i&, j&, k&
PS = Application.PathSeparator
sPath = ThisWorkbook.Path If Right(sPath, 1) <> PS Then sPath = sPath & PS
For i = 5 To RowX Block = Cells(i, 1).Value If Block <> "" Then StrX = "comment 0 " & Block Do While Cells(i, 4).Value <> 0 StrX = StrX & vbNewLine & "movie 0:00:00.00 R:" & Cells(i, 4).Value & ".avi" i = i + 1 Loop Check = SaveTXTfile(sFolder & Block & "-PEK.air", StrX) End If Next i
MsgBox "Done"
End Sub
Function SaveTXTfile(ByVal filename As String, ByVal txt As String) As Boolean 'Функция сохранения файла, спасибо => http://excelvba.ru/code/txt
Dim fso, ts
On Error Resume Next Err.Clear
Set fso = CreateObject("scripting.filesystemobject") Set ts = fso.CreateTextFile(filename, True) ts.Write txt ts.Close SaveTXTfile = Err = 0
При тестировании если в ячейке А2 стоит строка: "на дату 1.03.2015 ok?" Ваш код выдает ошибку метода NewFolder. Плюс не обрезается строка в случае первых 9-ти чисел месяца.
KuklP, добрый день, у Вас интересный вариант.
При тестировании если в ячейке А2 стоит строка: "на дату 1.03.2015 ok?" Ваш код выдает ошибку метода NewFolder. Плюс не обрезается строка в случае первых 9-ти чисел месяца.Rioran
Роман, Москва, voronov_rv@mail.ru Яндекс-Деньги: 41001312674279
KuklP, Rioran, Подскажите, проблема в сортировке файлов, как сделать чтоб в имя файла от 1 до 9 подставлялся 0 перед числом чтоб выглядело так 01-PEK.air...09-PEK.air ?
KuklP, Rioran, Подскажите, проблема в сортировке файлов, как сделать чтоб в имя файла от 1 до 9 подставлялся 0 перед числом чтоб выглядело так 01-PEK.air...09-PEK.air ?d22cva
For i = 5 To RowX If Cells(i, 1).Value <> "" Then Block = Format(Cells(i, 1).Value, "00") StrX = "comment 0 " & Block Do While Cells(i, 4).Value <> 0 StrX = StrX & vbNewLine & "movie 0:00:00.00 R:" & Cells(i, 4).Value & ".avi" i = i + 1 Loop Check = SaveTXTfile(sPath & PS & Block & "-PEK.air", StrX) End If Next i
[/vba]
Можно проще: [vba]
Код
For i = 5 To RowX If Cells(i, 1).Value <> "" Then Block = Format(Cells(i, 1).Value, "00") StrX = "comment 0 " & Block Do While Cells(i, 4).Value <> 0 StrX = StrX & vbNewLine & "movie 0:00:00.00 R:" & Cells(i, 4).Value & ".avi" i = i + 1 Loop Check = SaveTXTfile(sPath & PS & Block & "-PEK.air", StrX) End If Next i