Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » ChotaL
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1 2 След.
Макросом поставить пароль на ZIP-архив
 
#
17.01.2017 16:18:09
Исправил, выдает ошибку
 
Перейти    
Макросом поставить пароль на ZIP-архив
 
#
17.01.2017 16:12:05
Андрей VG, в архиве один файл. По циклу по одной строке сформировал документ записал его в архив и отправил, и так далее.
 
Перейти    
Макросом поставить пароль на ZIP-архив
 
#
17.01.2017 15:41:13
Добрый день!

У меня задача состоит в том, чтобы пробежаться по строкам листа и сфорфировать документ. Одна строка = один документ в формате pdf и отправляется пользователю на почту.

Вопрос в том что у меня не получается заархивировать файл и поставить пароль на архив!
Код
Sub addData()
 
   Dim OpenPDFAfterCreating As Boolean, PDFFile As String
   Dim iMsg As Object
   Dim iConf As Object
   Dim Flds As Variant
   Dim oApp As New Shell32.Shell   Dim FileNameZip As String
     
     Application.DisplayAlerts = False
     Application.ScreenUpdating = False
     Application.EnableEvents = False
   
              For n = 1 To 10
                 If Sheet3.Cells(n + 1, 2) = "" Then
                     Exit Sub
                 End If
           
            Sheet2.Cells(6, 3) = Sheet3.Cells(n + 1, 1)
            Sheet2.Cells(8, 3) = Sheet3.Cells(n + 1, 2)
            Sheet2.Cells(10, 3) = Sheet3.Cells(n + 1, 3)
            Sheet2.Cells(18, 1) = " " & "Dear," & " " & Sheet3.Cells(n + 1, 2)
            Sheet2.Cells(21, 2) = Sheet3.Cells(n + 1, 4)
            Sheet2.Cells(22, 2) = Sheet3.Cells(n + 1, 5)
            Sheet2.Cells(23, 2) = Sheet3.Cells(n + 1, 6)
            Sheet2.Cells(24, 2) = Sheet3.Cells(n + 1, 7)
            
            psW = Sheet1.Cells(n + 1, 9)
            sendto = Sheet3.Cells(n + 1, 8)
            PDFFile = Sheet3.Cells(n + 1, 2) & ".pdf"
            
            Sheet2.ExportAsFixedFormat xlTypePDF, PDFFile, xlQualityStandard, False, False, , , OpenPDFAfterCreating
            
            FileNameZip = Sheet3.Cells(n + 1, 2) & ".zip"
            Set oApp = CreateObject("Shell.Application")
            oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(PDFFile).Items
            
               'Keep script waiting until Compressing is done
                On Error Resume Next
                  Do Until oApp.Namespace(FileNameZip).Items.Count = _
                     oApp.Namespace(FolderName).Items.Count
                   Application.Wait (Now + TimeValue("0:00:01"))
                 Loop
                On Error GoTo 0
            Set iMsg = CreateObject("CDO.Message")
            Set iConf = CreateObject("CDO.Configuration")
            iConf.Load -1
            Set Flds = iConf.Fields
            With Flds
                .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
                .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Pupkin
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "SMTP"
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
                .Update
            End With             With iMsg
                Set .Configuration = iConf
                      .From = "pupkin@gmail.com"
                      .To = sendto
                      .Subject = "Example"
                      .HTMLBody = "<html><body>" & _
                                  " " & "Dear, " & Sheet3.Cells(I + 1, 2) & "!" & "<br><br>" & _
                                  "</body></html>"
                    .AddAttachment FileNameZip
                      .Send
              End With
                  
                Set iConf = Nothing
                Set iMsg = Nothing
                Set Flds = Nothing
        
        Next
                  
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
End Sub
Изменено: ChotaL - 17.01.2017 15:59:31 (дополнение)
 
Перейти    
Заполнение файла Word и отправка его по почте
 
#
10.01.2017 13:38:47
Добрый день!

Нужно заполнить файл ворд данными по строкам из excel, поставить пароль на word файл и отправить пользователю на почту.
Не могу поставить пароль на файл.
Код
Sub addData()   

   Dim oW As New Word.Application
   Dim oD As Word.Document
  '' Dim OL As Object, MailSendItem As Object
    '' Application.DisplayAlerts = False
    
     Application.ScreenUpdating = False
     Application.EnableEvents = False        Set oD = oW.Documents.Open("\Test.docx")
           For i = 1 To 10
            oD.FormFields("department").Result = Sheet1.Cells(i + 1, 1)
            oD.FormFields("employee_name1").Result = Sheet1.Cells(i + 1, 2)
            oD.FormFields("position_").Result = Sheet1.Cells(i + 1, 3)
            oD.FormFields("employee_name2").Result = Sheet1.Cells(i + 1, 2)
            oD.FormFields("month_gross").Result = Sheet1.Cells(i + 1, 4)
            oD.FormFields("year_gross").Result = Sheet1.Cells(i + 1, 5)
            oD.FormFields("bonus").Result = Sheet1.Cells(i + 1, 6)
            oD.FormFields("total").Result = Sheet1.Cells(i + 1, 7)
            oD.Password = Sheet1.Cells(i + 1, 8)
            oW.Application.Visible = False
            oW.ActiveDocument.SaveAs2 "\" & Sheet1.Cells(i + 1, 2) & ".docx"
          Next
  ''  Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
 
Перейти    
Сформировать таблицу курса валют
 
#
21.12.2016 12:18:17
Добрый день!

Не силен в VBA незнаю как сформировать таблицу в нужный мне формат primer2.png.
Выводит результат как на рисунке primer1.png
Изменено: ChotaL - 21.12.2016 12:29:31 (Пожалуйста измените тему на: "Сформировать таблицу курса валют")
 
Перейти    
Формирование таблицы курса валют с Web
 
#
07.12.2016 06:32:39
Добрый день!

Пытаюсь сделать файл в котором на заданные даты отображались курсы валют. Вот ссылка запроса http://nationalbank.kz/?docid=747&sDate=01/11/2016&edate=07/12/2016&idval=5&flag=100&ok3=yes&switch=...

Когда делаю Веб запрос выдает результаты что на листе Sheet2.
Не могу понять как сделать чтобы результат был как на Sheet1. Задаем нужные даты, нажимаем на кнопку и вывод результата.
 
Перейти    
Изменить XPath ячейки на листе с XML
 
#
12.07.2016 09:48:54
The_Prist, извиняюсь

Не верно составил вопрос.

Во вложенном файле, если вы зайдете во вкладку Разработчик/Источник увидите как раставленна структура xml файла на листе. Мне нужно когда выполяется условие, если равно 0 то ячейки B23 и B29 очищаются от xml , а если равно 1 то в ячейке B23 было xml (/sellers/seller/statuses/status) и B29 (/customers/customer/statuses/status)  
 
Перейти    
Изменить XPath ячейки на листе с XML
 
#
12.07.2016 06:58:46
Добрый день, форумчане

У меня такой вопрос по VBA

У меня есть XML map в Excel отрывок кода в котором у меня загвоздка:
Впервом условии все нормально удаляет xml, а во втором я не могу его обратно поставить
Подскажите, где я, что не так сделал?!
Код
                If .Range("R" & i) = 0 Then
                    Range("B23").XPath.Clear
                    Range("B29").XPath.Clear
                End If
                If .Range("R" & i) = 1 Then
                    strXPath = "/sellers/seller/statuses/status"
                    Range("B23").XPath.SetValue myMap, strXPath
                    Range("B23") = "EXPORTER"
                    Range("B29") = "NONRESIDENT"
                    
               End If
 
Перейти    
Уведомление на почту outlook через excel
 
#
02.06.2016 13:58:36
Добрый день форумчане!

У меня такой вопрос, можно ли по файлу excel сделать своего рода автоматическую напоминалку на почту outlook?

Например если в столбце C запись Monthly и в столбце D P3(Месяц март), отправлять уведомление на 7,15,21 число месяца и затем пока не будет в столбцах F и G запись YES
Аналогично с Quarterly Q1-Q4 название кварталов, Q1(P1,P2,P3) т.е. приходит уведомление на последний месяц в квартале как в примере выше.
Изменено: ChotaL - 02.06.2016 14:01:50
 
Перейти    
Копирование листа из одной книги в другую VBA Excel
 
#
05.05.2016 13:40:03
CrazyRabbit выдает ошибку
Method or data member not found
 
Перейти    
Копирование листа из одной книги в другую VBA Excel
 
#
05.05.2016 12:56:14
Добрый день,

Выдает ошибку что нельзя скопировать лист из выбранного файла и вставить в книгу
Код
Sub DownloadSheet()
        Dim sFile As String, sh As Worksheet, ac As Long
        With Application.FileDialog(msoFileDialogFilePicker)
            .Filters.Clear
           .Filters.Add "Microsoft Excel files", "*.*"
            .AllowMultiSelect = False
            .InitialFileName = ThisWorkbook.Path
            If .Show = 0 Then Exit Sub
               sFile = .SelectedItems(1)
        End With
        Set sh = ActiveWorkbook.ActiveSheet
                With Application
                    .ScreenUpdating = False
                     .EnableEvents = False
                      ac = .Calculation: .Calculation = xlCalculationManual
            With GetObject(sFile).Sheets("Sheet1")
                      .[D6].CurrentSheet.Copy sh:=.Sheets("Main")
                      .Parent.Close False
            End With
                     .ScreenUpdating = True
                      .EnableEvents = True
                     .Calculation = ac
        End With
End Sub
 
Перейти    
VBA offset перемещение ячеек
 
#
29.04.2016 08:17:59
Sanja я извиняюсь но у меня остался еще вопрос. Как после того сравнения которого вы сделали, т.е. после выбора товара подтянулись еще данные по оставшимся таблицам на листе 1

Разобрался)
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [A1]) Is Nothing And Target.Count = 1 Then
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error Resume Next
    With Worksheets("Ëèñò2")
        arrSN = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
        Set Tabl = Range("Table2[Íàèìåíîâàíèå òîâàðîâ, ðàáîò, óñëóã]")
        Set Tabl1 = Range("Table2[Öåíà áåç íàëîãà]")
        Set Tabl2 = Range("Table2[Öåíà ñ ó÷åòîì íàëîãà]")
        Set Tabl3 = Range("Table2[Êîëè÷åñòâî]")
        Tabl.ClearContents
        Tabl1.ClearContents
        Tabl2.ClearContents
        Tabl3.ClearContents
        k = 1
        For I = LBound(arrSN) To UBound(arrSN)
            If arrSN(I, 1) = Target.Value Then
                If .Range("C" & I + 1) = "RV" Then
                    Tabl(k) = .Range("E" & I + 1)
                    Tabl1(k) = .Range("F" & I + 1)
                    Tabl2(k) = .Range("G" & I + 1)
                    Tabl3(k) = .Range("H" & I + 1)
                Else
                    Tabl(k) = .Range("D" & I + 1)
                    Tabl1(k) = .Range("F" & I + 1)
                    Tabl2(k) = .Range("G" & I + 1)
                    Tabl3(k) = .Range("H" & I + 1)
                End If
                k = k + 1
            End If
        Next
    End With
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    End If
End Sub
Изменено: ChotaL - 29.04.2016 08:49:15
 
Перейти    
VBA offset перемещение ячеек
 
#
29.04.2016 07:41:06
Sanja спасибо, буду знать.
 
Перейти    
VBA offset перемещение ячеек
 
#
29.04.2016 05:56:50
В ячейке A12 есть выпадающий список, если я его перетаскиваю в другую ячейку и указываю его адрес код не работает.

Подскажите как работает offset. Мне сказали что из за него
Код
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
    If Not Intersect(Target, [A12]) Is Nothing And .Count = 1 Then
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error Resume Next
        arrSN = Worksheets("Лист2").Range("B2:B" & Cells(Rows.Count, 1).End(xlUp).Row).Value
      Range("Table2[Наименование товаров, работ, услуг]").ClearContents
        k = 1
        For I = LBound(arrSN) To UBound(arrSN)
            If arrSN(I, 1) = .Value Then
                If Worksheets("Лист2").Range("D" & I + 1) = "RV" Then
                    .Offset(k, 1) = Worksheets("Лист2").Range("F" & I + 1)
                Else
                    .Offset(k, 1) = Worksheets("Лист2").Range("E" & I + 1)
                End If
                k = k + 1
            End If
        Next
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    End If
End With
End Sub
Изменено: ChotaL - 29.04.2016 05:59:15
 
Перейти    
VBA вставка формулы в ячейку
 
#
28.04.2016 15:53:07
Sanja а почему если я перемещяю ячейку А12 в другое место, у меня не работает, хоть и в коде указываю позицию ?!
 
Перейти    
VBA вставка формулы в ячейку
 
#
28.04.2016 14:54:31
Извиняюсь, все работает
Изменено: ChotaL - 28.04.2016 14:55:34
 
Перейти    
VBA вставка формулы в ячейку
 
#
28.04.2016 14:10:36
Спасибо сделал))
Код
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
    If Not Intersect(Target, [A12]) Is Nothing And .Count = 1 Then
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error Resume Next
        arrSN = Worksheets("Лист2").Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
        Worksheets("Лист1").Range("Table2[Наименование товаров, работ, услуг]").ClearContents
        k = 1
        For I = LBound(arrSN) To UBound(arrSN)
            If arrSN(I, 1) = .Value Then
                If Range("C" & I + 1) = "RV" Then
                    .Offset(k, 1) = Worksheets("Лист2").Range("E" & I + 1)
                Else
                    .Offset(k, 1) = Worksheets("Лист2").Range("D" & I + 1)
                End If
                k = k + 1
            End If
        Next
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    End If
End With
End Sub
Изменено: ChotaL - 28.04.2016 14:14:05
 
Перейти    
VBA вставка формулы в ячейку
 
#
28.04.2016 13:37:14
Sanja да вы верно подметили
Цитата
Просто, судя по всему, автор не знает о возможности другого пути решения, кроме как через вставку формулы.
У меня теперь такой вопрос, а если таблица с данными A1:E7 будет в другом листе, что нужно изменить в коде ?
 
Перейти    
VBA вставка формулы в ячейку
 
#
28.04.2016 09:48:50
Catboyun, нужно вставить формулу в умную таблицу, она не должна быть там всегда!
 
Перейти    
VBA вставка формулы в ячейку
 
#
28.04.2016 09:38:38
Sanja приложил файл пример
Нужно чтоб в умную таблицу после нажатия кнопки вставилась формула с помощью VBA
 
Перейти    
VBA вставка формулы в ячейку
 
#
28.04.2016 09:17:20
Sanja а как это тогда ? я не совсем понимаю
 
Перейти    
VBA вставка формулы в ячейку
 
#
28.04.2016 09:10:22
Ivan.kh ой сорри это столбец C
 
Перейти    
VBA вставка формулы в ячейку
 
#
28.04.2016 08:59:37
Ошибка при вставке формулы в ячейку при помощи VBA
Код
Sub InsertFormula()
 Application.Calculation = xlCalculationManual
    Range("Ñ37").Formula = "=IFERROR(INDEX((rus!$I$5:$I$4728,rus!$J$5:$J$4728),SMALL(IF(rus!$AC$5:$AC$4728=$D$5,ROW($5:$4728)),ROW(rus!$AC1)),,IF(INDEX(rus!$AD5:$AD$4728,MATCH($D$5,rus!$AC$5:$AC$4728,0))='RV',1,2)),"")"
    Application.Calculation = xlCalculationAutomatic
End Sub
 
Перейти    
Вывод данных, равных введенному значению
 
#
28.04.2016 08:05:18
Сергей а как данную формулу вствить в умную таблицу с помощью VBA ?!
 
Перейти    
Вывод данных, равных введенному значению
 
#
28.04.2016 07:30:38
Спасибо
 
Перейти    
Вывод данных, равных введенному значению
 
#
28.04.2016 07:23:24
Сергей я показал часть своих таблиц, но впр не может же с полной точностью найти а ИНДЕКС+ПОИСКПОЗ может
 
Перейти    
Вывод данных, равных введенному значению
 
#
28.04.2016 07:11:59
Сергей  , а как здесь поменять ВПР на Индекс+Поискпоз ?!
Код
ЕСЛИ(ВПР($A$12;$A$2:$C$7;3;0)="RV";1;2))
 
Перейти    
Вывод данных, равных введенному значению
 
#
28.04.2016 06:27:31
Сергей спасибо, все как нужно вы сделали, такой вопрос я незнаю как сделать выпадающийся список без повторений как вы сделали в A12
 
Перейти    
Вывод данных, равных введенному значению
 
#
28.04.2016 05:57:05
jakim спасибо, но не совсем верно.
Если тип документа = DR то выводить товары из столбца D
Если тип документа = RV то выводить товары из столбца E
 
Перейти    
Вывод данных, равных введенному значению
 
#
27.04.2016 16:32:07
Sanja спасибо, но здесь моя ошибка я забыл добавить если в А12 ввести 65874895, тогда должно вывести Сахар, Гречка т.к. определяется по ячейке в строке DR, если в строке присутсвует поле RV должно выводить название товаров из столбца Е. RV = столбец Е, DR = столбец D
 
Перейти    
Страницы: 1 2 След.
Наверх