cthu
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Программа будет интерена тем, кто использует прайс-листы в программе PRO100
<br>
Продаёт при помощи программы Шкафы купе
Мебель<br>
Основные функции:<br>
Копирование с PRO100 спецификации по материалам<br>
Использование:
- Сделать проект в PRO100
- Вызвать сумму в спецификации
- Нажать кнопку копировать
- Запустить спецификацию в Excel
- Перейти на страницу "Импорт с PRO100"
- Нажать кнопку "Импорт с PRO100"
- На закладке спецификация будут Ваши данные
Идея работы заключается в буфере обмена, который копирует документ, а потом при помощи макросов обрабатывается и с неё удаляется всё лишнее.
Ниже представлен исходный код программы (Язык VisualBasic)<br>
<p><font color="#00FF00"><textarea rows="16" name="S1" cols="100%">Sub blank()
'///////////////////////
' Макрос1
' Макрос записан 06.07.2007 Yason
' http://forum.yason.org.ua
'///////////////////////
'Очистка спецификации
Sheets("Спецификация").Select
Range("B16:E70,H16:K70").Select
Selection.ClearContents
Range("B16").Select
Sheets("Импорт PRO100").Select
'Вставка копированного текста из PRO100
Range("E1").Select
ActiveSheet.PasteSpecial Format:="Текст", Link:=False, DisplayAsIcon:= _
False
Range("E1").Select
' Поиск пустой ячейки
Do While Not IsEmpty(ActiveCell.Value)
ActiveCell.Offset(1, 0).Select
Loop
'Выделение заданных ячеек листа
Dim strSelTop As String, strSelBottom As String
' Перемещение на один курсор вверх
strSelBottom = ActiveCell(0, 1).Address
strSelTop = Cells(1, ActiveCell.Column + 3).Address
Range(strSelTop & ":" & strSelBottom).Select
'Фильтровка по алфавиту
Selection.Sort Key1:=Range("E1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
' Вставка списка в спецификацию
Selection.Copy
Sheets("Спецификация").Select
Range("B16").Select
Selection.PasteSpecial paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _:=False,
Transpose:=False
Sheets("Импорт PRO100").Select
Columns("E:K").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("E1").Select
End Sub
</textarea></font></p>
Пример находится здесь
http://forum.yason.org.ua/index.php?showtopic=9
Хотелось бы ус лышать мнение публики...
<br>Жду отзывов  |
