Ru-Board.club
← Вернуться в раздел «Прикладное программирование»

» Excel VBA (часть 3)

Автор: febreze2009
Дата сообщения: 26.11.2010 09:12

Цитата:
febreze2009
в свойствах принтера - дополнительно - использовать очередь печати - начинать печатать после помещения в очередь всего задания
если не поможет, то копировать всё на один временный лист, и печатать его


Настройки принтера не вариант. Он постоянно используется для другого. А вот с временным листом, можно чуть подробнее?
Автор: smirnvlad
Дата сообщения: 26.11.2010 10:40
febreze2009
копирование на временный лист
[more]
Код: [no]
Private Sub CommandButton1_Click()
ListNumCell = "G2"
k = TextBox1.Value

Set cSh = ActiveSheet
lastrow = cSh.Cells.SpecialCells(xlLastCell).Row

' Считываем текущий номер
MaxNum = cSh.Range(ListNumCell).Value + 1 ' +1 выводим на печать начиная со следующего

' Устанавливаем первый печатаемый номер
cSh.Range(ListNumCell).Value = MaxNum

cSh.Copy before:=cSh
Set nSh = Sheets(cSh.Index - 1)

' один номер уже скопирован осталось k-1
For i = 1 To k - 1
' увеличиваем номер до печати
cSh.Range(ListNumCell).Value = MaxNum + i
cSh.Rows("1:" & lastrow).Copy
nSh.Rows(1).Insert Shift:=xlDown
nSh.HPageBreaks.Add before:=nSh.Rows(lastrow + 1)
Next i
Application.CutCopyMode = False

' печать листа без диалога печати
nSh.PrintOut

' удаляем временный лист без подтверждения
Application.DisplayAlerts = False
nSh.Delete
Application.DisplayAlerts = True

End Sub

[/no]
Автор: febreze2009
Дата сообщения: 26.11.2010 17:36

Цитата:
febreze2009
копирование на временный лист
Подробнее...


Ух ты. Спасибо.
А насколько данный метод требователен к ресурсам. Это я к тому, что если запускать на пару листов на печать, а сотню, Excel со своим виртуальным листом не повесится?
Автор: smirnvlad
Дата сообщения: 26.11.2010 18:51
febreze2009
до 500 шт. думаю проблем не возникнет, если нужно больше можно разделить на части, например, по 100шт
Автор: TuvanMAN
Дата сообщения: 29.11.2010 21:55
Есть сделанный Excel VBA проект, мне нужно сделать что-то вроде этого. С Excelem разобрался, но VBA никак не могу осилить за пару дней помогите.
И подскажите как файлы прикрепить?
Автор: mcdie
Дата сообщения: 30.11.2010 08:28
TuvanMAN
В смысле прикрепить?
Это Alt+F11?
Автор: TuvanMAN
Дата сообщения: 30.11.2010 15:14
mcdie

можно файлы на форум как нить прикрепить?

Автор: mcdie
Дата сообщения: 30.11.2010 16:26
TuvanMAN
+ там есть возможность добавления модуля (правой кнопкой по VBAProject потом Insert), его экспорт и импорт.
Если нужен экспорт, то в *.Bas файл будет экспорт. Его и прикрепляй к ветке форума.
А как сам файл прикрепить, это надо выложить его на файлообменник и дать ссылку.
Автор: exs_godlike
Дата сообщения: 08.12.2010 13:11
Вобщем нужно доделать программку, а именно сделать так чтобы при нажатии на кнопку Расчитать появлялась стоимость выбранных компонентов ( компоненты прописаны, стоимость брать в пределах разумного) также стоит учитывать скидку

файлы проекта

http://rghost.ru/3526812
Автор: AndVGri
Дата сообщения: 09.12.2010 05:47
exs_godlike

Цитата:
стоимость брать в пределах разумного

А где взять это разумное?
Автор: JekG
Дата сообщения: 10.12.2010 09:38
Подскажите может кто знает. Макросом каждую неделю формируется некий отчет, потом тем же макросом отсылается на мыло адресату. Хотелось бы для самоконтроля добавить в конец макроса задание писать в текстовый документ (txt) созданный в папке с отправляемыми отчетами строку типа "Файл такойто (имя файла) успешно отправлен такого то числа"

Реально ли это организовать средствами VBA?
Автор: ZlydenGL
Дата сообщения: 10.12.2010 09:48
JekG, легко! В конец макроса, сразу после отправки сообщения, вставляем код:


Код: If Err.Number = 0 Then ' если операция отправки не вызвала ошибок - предполагаю, что где-то раньше встречается конструкция On Error Resume Next или подобный обработчик
Open ThisWorkbook.Path & "\log_report.txt" For Append As #1
Print #1, "Файл " & FileName & " успешно отправлен " & Now()
End If
Автор: JekG
Дата сообщения: 10.12.2010 10:10
ZlydenGL
Макрос отработал но в отчет ничего не попало Вот полный код макроса отправки почты. Гляньте плз

[more]
Код: [no]
Sub SendMail() ' Отправка отчета по почте
txt = "Здравствуйте, Ольга!" & vbNewLine & _

If Send_Mail("XXX@gmail.com", "YYY@mail.ua", "Отчет СКД", txt) Then
MsgBox "Письмо успешно отправлено", vbInformation
Else
MsgBox "Не удалось отправить письмо", vbExclamation
End If

If Err.Number = 0 Then ' если операция отправки не вызвала ошибок - предполагаю, что где-то раньше встречается конструкция On Error Resume Next или подобный обработчик
Open ThisWorkbook.Path & "\log_report.txt" For Append As #1
Print #1, "Файл " & Filename & " успешно отправлен " & Now()
End If

End Sub

Function Send_Mail(ByVal MailTo As String, ByVal MailFrom As String, _
ByVal MailSubject As String, ByVal MailText As String, _
Optional ByVal MailAttachment As String = "") As Boolean
' функция для отправки почты без использования внешних почтовых программ
' ----------------------------------------------------------------------
' в качестве параметров получает:
' MailTo - адрес получателя письма
' MailFrom - адрес отправителя письма
' MailSubject - тема письма
' MailText - текст письма
' MailAttachment - полный путь к файлу вложения (необязательный параметр)
' ----------------------------------------------------------------------
' возвращает TRUE, если отправка почты произошла успешно, и FALSE в обратном случае

Dim TempFilePath As String
TempFilePath = "C:\Windows\Temp\" & ActiveWorkbook.Name & ".xls"
ActiveWorkbook.SaveCopyAs (TempFilePath)

Const cdoConfigURL = "http://schemas.microsoft.com/cdo/configuration/"
On Error Resume Next: Err.Clear

smtpserver = GetSetting(Application.Name, "mail", "smtpserver", "")
sendusername = GetSetting(Application.Name, "mail", "sendusername", "")
sendpassword = GetSetting(Application.Name, "mail", "sendpassword", "")
If Len(smtpserver) = 0 Or Len(sendusername) = 0 Or Len(sendpassword) = 0 Then Exit Function

Set cdoConfig = CreateObject("CDO.Configuration")
With cdoConfig.Fields
.Item(cdoConfigURL & "sendusing") = 2
.Item(cdoConfigURL & "smtpauthenticate") = 1
.Item(cdoConfigURL & "smtpserver") = smtpserver
.Item(cdoConfigURL & "sendusername") = sendusername
.Item(cdoConfigURL & "sendpassword") = sendpassword
.Update
End With

Set cdoMessage = CreateObject("CDO.Message")
With cdoMessage
Set .Configuration = cdoConfig
.BodyPart.Charset = "koi8-r"
.From = MailFrom:
.To = MailTo
.Subject = MailSubject
.TextBody = MailText
.AddAttachment TempFilePath
.Send
End With
Set cdoMessage = Nothing: Set cdoConfig = Nothing
'Check that file exists
If Len(Dir$(TempFilePath)) > 0 Then
'First remove readonly attribute, if set
SetAttr TempFilePath, vbNormal
'Then delete the file
Kill TempFilePath
End If

' If Err.Number = -2147220973 Then MsgBox ("Отсутствует связь с интернетом")
' If Err.Number = -2147220975 Then MsgBox ("SMTP сервер ответил отказом")
' If Err.Number = 0 Then MsgBox ("Письмо отправлено")
Send_Mail = Err = 0
End Function

[/no]
Автор: ZlydenGL
Дата сообщения: 10.12.2010 10:20
Через конвертер прогнать

Ну все правильно, модифицировать надо процедуру Sub SendMail(), конкретно сразу после строки

Код: MsgBox "Письмо успешно отправлено", vbInformation
Автор: JekG
Дата сообщения: 10.12.2010 10:30
Кстати а запрсить подверждение доставки как это делается скажем в Outlook на VBА реально?
Автор: ZlydenGL
Дата сообщения: 10.12.2010 10:45
JekG, ты в исходный код все-таки не туда вставил обработку. В твоем случае err.number вообще всегда нулю будет равен Лучше в имеющееся IF плечо добавь.

Добавлено:

Цитата:
подверждение доставки

Если не ошибаюсь, то через

Код: With CDO.Message
...
.DSNOptions = 14 ' Уведомлять о ЛЮБЫХ событиях
End With
Автор: ViktorGil
Дата сообщения: 10.12.2010 14:27
Не пойму почему этот код работает:

Код: If cc.Value <> "SUM_KVIT" Then
If cc.Value <> "SUM_OPL" Then
cc.Value = cc * 1
End If
End If
Автор: ZlydenGL
Дата сообщения: 10.12.2010 14:38
ViktorGil, потому что ошибка в булевой логике Выражение второго кода НИКОГДА не вернет истину. Правильней будет так:

Код: If cc.Value <> "SUM_KVIT" And cc.Value <> "SUM_OPL" Then
cc.Value = cc * 1
End If
Автор: ViktorGil
Дата сообщения: 10.12.2010 14:49
Было переделано на это:

Код: If IsNumeric(cc.Value) Then cc.Value = cc * 1
Автор: ZlydenGL
Дата сообщения: 10.12.2010 14:51
ViktorGil, задача состоит в том, что текстовые ячейки надо перевернуть в цифровые?
Автор: mcdie
Дата сообщения: 10.12.2010 15:00
ViktorGil
Есть еще такая функция как CDbl и CInt - перевод в числа дробные и целые соотвественно.


Автор: ZlydenGL
Дата сообщения: 10.12.2010 15:03
mcdie, ага, именно их я и планировал присоветовать, если задача именно в этом заключается
Автор: ViktorGil
Дата сообщения: 10.12.2010 15:10
Задача такая: Открывается текстовый файл, содержащий текстовые и цифровые значения. Соответственно при открытии получается, что число отформатировано как текст и для исправления этого была задумана эта часть кода.

Код:
cc.Value = CDbl(cc.Value)
cc.NumberFormat = "0.00"
Автор: JekG
Дата сообщения: 10.12.2010 15:58

Цитата:
Кстати, в случае записи лога msgbox можно вообще закомментировать, чтоб двойного события не было. А можно еще и на второе плечо повесить также запись о НЕУДАЧНОЙ отправке


А как это сделать? И еще будет ли это один лог файл, в который будут по мере отправления отчетов добавляться строки или каждый раз будет создаваться новый файл? Мне лучше первое.
Автор: ZlydenGL
Дата сообщения: 10.12.2010 16:09
ViktorGil, подсказываю - Эксельная функция

Код: =Value()
Автор: JekG
Дата сообщения: 10.12.2010 17:17
ZlydenGL
Чет я не то натворил терь файлы аттачатся с двойным расширением 06.12.2010.xls.xls
Не вижу где это прописано.

И кстати все попытки создавать лог заканчиваются тем, что лог пишется в екселевский файл log_report который хранится непонятно где

Добавлено...
Со вторым я кажется понял... Макрос у меня выполняется из персональной книги макросов, и стало быть лог падает тудаже. Нужно задать жесткий путь в условии.
Автор: ZlydenGL
Дата сообщения: 10.12.2010 19:09
JekG, по пути лога - тогда ссылайся на ActiveWorkbook.Path вместо ThisWorkbook.Path - в этом случае файл лога окажется в той же директории, в которой находится АКТИВНАЯ книга. Только отдельно обработай ситуацию, что книга может быть не сохранена А по поводу расширения - смотри свой код, я затрагивал только процедуру отправки...
Автор: DreadfulAngel
Дата сообщения: 10.12.2010 21:26
Есть такая программа - Protect VBA. Она делает проект VBA Unviewable. Версия 1.6 была сделана разработчиком бесплатной для использования. http://www.downloadsnet.com/index/software/view/authoring-tools/tools-editors/specialized-tools/protect-vba/100452__0_0.html?hl=&id=100452
Это лучше чем простая защита проекта. Снятие защиты с помощью Advanced VBA Password Recovery не помогает: файл перестаёт открываться Excel.
Эта прога правит поток project в VBA_PROJECT_CUR представляющий из себя текстовый файл с параметрами проекта. На форумах пишут, что проект легко востанавливается с помощью любого редактора компаунд документов. Например, можно использовать плагин DocFile Browser Игоря Павлова, применяемый с FAR или Total Commander. (http://plugring.farmanager.com/download.php?l=ru&fid=54) Мы можем извлечь файл project и поменять его.

Может кто-нибудь подскажет как это сделать: что нужно заменить в файле project?
Автор: JekG
Дата сообщения: 10.12.2010 21:31
ZlydenGL
Совсем запутался По ссылке на ThisWorkbook.Path лог создается, но не там, где нужно, а по ссылке ActiveWorkbook.Path не создается вовсе, хотя макрос ошибки не выдает ... Чудеса блин...
Автор: ZlydenGL
Дата сообщения: 12.12.2010 12:54
JekG, такая ситуация возможна, если ActiveWorkbook еще никуда не сохранялась (т.е. макросом книга создана и заполнена, но команды Save/SaveAs не давалось). Соответственно параметр ActiveWorkbook.Path в этом случае будет пустым

Добавлено:
Хотя у меня при незаполненном ActiveWorkbook.Path файл сохранился в корень пользовательского диска

Страницы: 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127

Предыдущая тема: VS 2010


Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.