18+ 
Волгоградский форум - Главный форум Волгограда.   

  

Ответ
Волгоградский форум » Программы » Программирование »  Visual Basic - доработать макрос.
Программирование - Средства разработки, СУБД, разработка, внедрение. WEB-технологии.
 
Опции темы Поиск в этой теме
Старый 24.12.2015, 10:48   #1
Pashtet Меню пользователя Pashtet Мужской
Аватар для Pashtet
Участник
Красноармейский
Сообщений: 19401
Visual Basic - доработать макрос.

Народ, кто знаком с Visual Basic, в плане написания макросов для Exel - помогите!
Суть - есть екселевский файлик + макрос в нем. Функция макроса, по запуску, формирует фаил с разделителями на основе данных из таблицы. Затем запрашивает, куда сохранить.
Нужно, что бы после того, как сохранил фаил, автоматом, в той же папке создавал пустой фаил с заранее заданным именем (фаил флаг).
Чет, вчера пошарил по инету, но так и не нашел команды создания файла без диалогового окна.
Сам фаил лежит тут
http://fs.atol.ru/_layouts/15/atol.t...3f0561&webUrl=

Текст макроса.
Sub SaveFile()
Dim Data ' массив куда скидывается строка Номенклатуры
Dim r As Long ' Номер строки
Dim Count_Nom As Long
Dim Filt As String ' Фильтр файла
Dim FileName As Variant ' Путь к файлу загрузки плюс его имя
Dim Count_Ost As Long 'номер нижней заполненой строки в Остатках
Dim oo As Long 'текущая строка справочника Остатков



Count_Nom = Sheets("Номенклатура").Cells(Sheets("Номенклатура" ).Rows.Count, 2).End(xlUp).Row
Filt = "(*.txt),*.txt," & "(*.sprt),*.sprt," & "(*.*),*.*"
FileName = Application.GetSaveAsFilename("in", Filt, 0, "Сохраните файл загрузки")
If FileName = False Then
MsgBox "Вы отменили сохранение файла загрузки"
Exit Sub
End If


Open FileName For Output As #1

Data = "##@@&&" & Chr(13) & Chr(10) & "#" & Chr(13) & Chr(10) & _
"$$$DELETEALLWARES" & Chr(13) & Chr(10) & "$$$ADDQUANTITY" & Chr(13) & Chr(10)
Print #1, Data;

r = 3
Do While r <= Count_Nom
If (Sheets("Номенклатура").Cells(r, 2) <> "") And (Sheets("Номенклатура").Cells(r, 4) = 0) Then
Data = Sheets("Номенклатура").Cells(r, 2).Value & ";" '1
Data = Data & Sheets("Номенклатура").Cells(r, 7) & ";" '2
Data = Data & Sheets("Номенклатура").Cells(r, 5) & ";" '3
Data = Data & Sheets("Номенклатура").Cells(r, 5) & ";" '4
Data = Data & Sheets("Номенклатура").Cells(r, 10) & ";" '5
Data = Data & Sheets("Номенклатура").Cells(r, 8) & ";" '6
Data = Data & "0;0;;0;" '7-10
Data = Data & Sheets("Номенклатура").Cells(r, 12) & ";" '11
Data = Data & "0;0;1;;" '12-15
Data = Data & Sheets("Номенклатура").Cells(r, 3) & ";" '16
Data = Data & Sheets("Номенклатура").Cells(r, 4) & ";" '17
Data = Data & "0;0;;;;" '18-22
Data = Data & Sheets("Номенклатура").Cells(r, 11) & ";" & Chr(13) & Chr(10) '23
Print #1, Data;
End If
r = r + 1
Loop

r = 3
Do While r <= Count_Nom
If (Sheets("Номенклатура").Cells(r, 2) <> "") And (Sheets("Номенклатура").Cells(r, 4) = 1) Then
Data = Sheets("Номенклатура").Cells(r, 2).Value & ";" '1
Data = Data & Sheets("Номенклатура").Cells(r, 7) & ";" '2
Data = Data & Sheets("Номенклатура").Cells(r, 5) & ";" '3
Data = Data & Sheets("Номенклатура").Cells(r, 5) & ";" '4
Data = Data & Sheets("Номенклатура").Cells(r, 10) & ";" '5
Data = Data & Sheets("Номенклатура").Cells(r, 8) & ";" '6
Data = Data & "0;0;;0;" '7-10
Data = Data & Sheets("Номенклатура").Cells(r, 12) & ";" '11
Data = Data & "0;0;1;" '12-14
Data = Data & Sheets("Номенклатура").Cells(r, 6) & ";" '15
Data = Data & Sheets("Номенклатура").Cells(r, 3) & ";" '16
Data = Data & Sheets("Номенклатура").Cells(r, 4) & ";" '17
Data = Data & "0;0;;;;" '18-22
Data = Data & Sheets("Номенклатура").Cells(r, 11) & ";" '23
Data = Data & ";;" '24-25
Data = Data & Sheets("Номенклатура").Cells(r, 13) & ";" & Chr(13) & Chr(10) '26 для алкоголя
Print #1, Data;
End If
r = r + 1
Loop

Data = "$$$REPLACEASPECTREMAINS"
Print #1, Data;
Count_Ost = Sheets("Остатки").Cells(Sheets("Остатки").Rows.Cou nt, 2).End(xlUp).Row
For oo = 3 To Count_Ost
If Sheets("Остатки").Cells(oo, 4) <> "" Then
Data = Chr(13) & Chr(10)
Data = Data & Sheets("Остатки").Cells(oo, 2) & ";" '1 Код
Data = Data & Sheets("Остатки").Cells(oo, 6) & ";" '2 Остаток
Data = Data & Sheets("Остатки").Cells(oo, 4) & ";" '3 Коды значений разрезов
Data = Data & Sheets("Остатки").Cells(oo, 5) & ";" '4 Цена
Data = Data & ";;" '5-6
Print #1, Data;
End If
Next

Close #1
MsgBox ("Файл выгрузки ''" & FileName & "'' создан. ")
End Sub
__________________
реклама запрещена
Pashtet вне форума   Ответить с цитированием
  
Старый 24.12.2015, 20:08   #2
gerodoth Меню пользователя gerodoth
Аватар для gerodoth
Участник
Бобруйск
Сообщений: 7942
очевидно после Close #1
из строки FileName нужно получить папку
fso.GetParentFolderName(FileName)
из него получить желаемое имя флага, что-то типа
FlagName = fso.GetParentFolderName(FileName) & "Flag.Ext"
а потом записать файл на диск
Dim fso, f1
Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.CreateTextFile(FlagName, True)

но я на вбс писать не умею
gerodoth вне форума   Ответить с цитированием
Программирование - Средства разработки, СУБД, разработка, внедрение. WEB-технологии.
Волгоградский форум » Программы » Программирование »  Visual Basic - доработать макрос.
Ответ

Фирма Ренессанс: лестницы деревянные маршевые - доставка, монтаж.купить стулья в интернет магазине дешевоорен фонд помоги больному ребенкушкаф лдспстол компьютерный каплевидный v283

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Visual Basic for Applications Дискретный Конь Программирование 25 11.10.2010 21:27
Visual Basic .net - Коробочная версия Knight Продам 2 08.12.2007 01:25
Лицензионный Visual Basic .NET 2003 BULDOG Продам 2 24.12.2005 00:05
Контрольная по програмированию на visual basic 6.0 SkroP Программирование 5 20.11.2005 22:56
Помогите с Visual Basic! SkroP Программирование 3 13.11.2005 12:39

© 2001 - 2017 ВОЛГОГРАДСКИЙ ФОРУМ
Полное или частичное копирование материалов с сайта разрешено только при обязательном указании автора и прямой гиперссылки на материал.
Rambler's Top100 Рейтинг@Mail.ru