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

Страницы: 1
Обновление остатков в Google sheet, Автоматизация остатков
 
#
20.02.2024 18:01:12
День добрый,
Нужно настроить автоматическое обновление остатков. Наименования товаров и количество - на первых 3 листах, лист с остатками - 4
Надо всё подвязать к 4 листу

Связь в тг [УДАЛЕНО]
Изменено: Юрий М - 20.02.2024 19:00:57
 
Перейти    
Изменение значения выделенной ячейки, скрипт
 
#
09.09.2022 17:42:05
Привет, как настроить скрипт, чтобы выделенная ячейка при использовании макроса меняла значение. Допустим было значение в ячейке 185 - выделяю ячейку, нажимаю макрос - значение стало 166.
Код ниже не работает, error - selection.getCurrentCell()
Код
function _61test() {
  var q = SpreadsheetApp.getActiveSpreadsheet()
  var cellD1 = q.getActiveSheet().selection.getCurrentCell().getValue();
  var minu = cellD1 - 61;
};
Макрос ниже работает, но он меняет, только значение ячейки В5, а нужно "по нажатию"
Код
function myFunction() {
  var q = SpreadsheetApp.getActiveSpreadsheet()
  var cellD1 = q.getActiveSheet().getRange("B5").getValue();
  var minu = cellD1 - 61;
  var s = q.getActiveSheet().getRange("B5").setValue(minu);
};
 
Перейти    
перенастроить макросы с аутлука на бат
 
#
08.11.2021 10:22:43
добрый день, сможете помочь за вознаграждение перенастроить макросы с аутлука на бат
телеграмм для связи  удалено  [МОДЕРАТОР]
Изменено: vikttur - 08.11.2021 10:26:57
 
Перейти    
The bat. Настроить макрос на отправку сообщений
 
#
04.11.2021 11:15:58
Добрый день, подскажите, как перенастроить этот же макрос на The bat, сейчас все работает отлично, но в аутлуке
 
Перейти    
Макрос для рассылки писем
 
#
09.02.2021 17:34:49
Добрый день, подскажите в чем ошибка кода ниже, есть подозрения, что чего-то не хватает с IF,  но не могу понять чего
Код
Dim sUs$    sUs = "12345@mail.ru"
    For lr = 2 To lLastR
        Set objMail = objOutlookApp.CreateItem(0)
        With objMail
          If lr >= lLastR - 1 Then                 
                 sUs = "54321@mail.ru"
             If lr >= lLastR - 1 Then                
                 sUs = "xxxx1@gmail.com"
             End If
             Set .SendUsingAccount = objOutlookApp.Session.Accounts.Item(sUs)
 
Перейти    
Макрос на отправку сообщений с разных учетных записей
 
#
09.02.2021 10:48:22
Код
Sub sendmail()

Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
      
    Application.ScreenUpdating = False
    
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    objOutlookApp.Session.Logon
    
    lLastR = Cells(Rows.Count, 1).End(xlUp).Row 'определяем последнюю заполненную ячейку в столбце А
    'цикл от второй строки(начало данных с адресами) до последней ячейки таблицы
    For lr = 2 To lLastR
        Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
        'создаем сообщение
        With objMail
        Set .SendUsingAccount = objOutlookApp.Session.Accounts.Item("12345@mail.ru")
            .To = Cells(lr, 1).Value 'адрес получателя
            .CC = Cells(lr, 2).Value 'копия
            .BCC = Cells(lr, 3).Value 'адрес для скрытой копии
            .Subject = Cells(lr, 4).Value 'тема сообщения
            .Body = Cells(lr, 6).Value 'текст сообщения
            If Not IsEmpty(Cells(lr, 5)) Then
                 If Dir(Cells(lr, 5).Value) <> "" Then
                 .Attachments.Add Cells(lr, 5).Value
                 End If
            End If
            .send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
        End With
    Next lr
          
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub

Добрый день, подскажите, что необходимо добавить в макрос, чтобы была возможность отправлять  2 крайних сообщения с другой учетки не 12345@mail.ru, а условно 54321@mail.ru, но только 2 крайних сообщения, заранее благодарю
Если это не возможно, просьба помочь, как данную проблему можно решить  
 
Перейти    
Перенос (копирование) строк и столбцов
 
#
20.10.2020 10:26:19
Добрый день, подскажите, пожалуйста возможен ли перенос ячеек и столбцов с одного файла в другой, расположенный на рабочем столе

у меня сейчас присутствует такой макрос, подскажите что надо прописать, чтобы до изменений в таблицы (до удаления ячеек) часть таблицы перенеслась в другой файл, который расположен на рабочем столе с названием 3 грубо говоря

Код
Sub Svodka()
'
' Svodka Макрос
'
' Сочетание клавиш: Ctrl+q
'
    Sheets("1").Select
    Sheets("2").Visible = True
    Sheets("1").Select
    ActiveWindow.SelectedSheets.Delete
    Columns("E:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("L:O").Select
    Selection.Delete Shift:=xlToLeft
    Range("K12").Select
    ActiveWindow.SmallScroll Down:=12
    ActiveWorkbook.SaveAs Filename:="C:\Users\Desktop\1.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
 
Перейти    
Несколько вложений в одном письме
 
#
02.09.2020 14:28:03
Добрый день, подскажите, пожалуйста, как вставить N-количество вложений в одно письмо
Код
Sub sendmail()

Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
      
    Application.ScreenUpdating = False
    
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    objOutlookApp.Session.Logon
    
    lLastR = Cells(Rows.Count, 1).End(xlUp).Row 'определяем последнюю заполненную ячейку в столбце А
    'цикл от второй строки(начало данных с адресами) до последней ячейки таблицы
    For lr = 2 To lLastR
        Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
        'создаем сообщение
        With objMail
            .To = Cells(lr, 1).Value 'адрес получателя
            .CC = Cells(lr, 2).Value 'копия
            .BCC = Cells(lr, 3).Value 'адрес для скрытой копии
            .Subject = Cells(lr, 4).Value 'тема сообщения
            .Body = Cells(lr, 6).Value 'текст сообщения
            If Not IsEmpty(Cells(lr, 5)) Then
                 If Dir(Cells(lr, 5).Value) <> "" Then
                 .Attachments.Add Cells(lr, 5).Value
                 End If
            End If
            .Display 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
        End With
    Next lr
          
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub
Вот код, пытаюсь через ;  в ячейке с вложениями прописать пути к файлам грубо говоря: Файл1.xlsx; Файл2.xlsx
Но макрос не запускается, вылетает 52 ошибка, не правильное название в файле :( убираю Файл2.xlsx, и с одним вложением всё прекрасно работает  
 
Перейти    
Отправка писем с других почтовых ящиков (которые также имеются в Outlook)
 
#
02.09.2020 09:38:34
Добрый день, я дико извиняюсь, но не нашёл аналогичной темы, хотя, скорее всего она есть
Подскажите, что нужно добавить, чтобы сообщения не отправлялись с ящика "по-умолчанию", а отправлялись с той учетной записи, с которой мне необходимо
Ниже код
Код
Sub test()
  
Dim objOutlookApp As Object, objMail As Object
 
    Application.ScreenUpdating = False
    On Error Resume Next
    Set objOutlookApp = CreateObject("Outlook.Application")
    objOutlookApp.Session.Logon
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
    On Error GoTo 0
    'создаем сообщение
    With objMail
        .To = Range("A63").Value
        .BCC = Range("A64").Value
        .Subject = Range("A65").Value
        .BodyFormat = 2  'olFormatHTML - формат HTML
        .HTMLBody = ConvertRngToHTM(Selection)
        .Display 'отображаем сообщение
    End With
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub
Изменено: Andrey Melnikov - 02.09.2020 11:02:26
 
Перейти    
Добавление диапазона ячеек (таблицы ) в тело письма
 
#
27.08.2020 10:51:33
Добрый день, пытаюсь в тело письма вставить таблицу (не вложением) , при использовании макроса письмо создаётся, но таблица не переносится, h e l p
Ошибка скорее всего в sBody = Range("A1:K41").Value   но решение, к сожалению, я пока не нашёл
Код
Sub test()

  Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
  
    Application.ScreenUpdating = False
    On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    objOutlookApp.Session.Logon
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
  
    sTo = Range("A45").Value  'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
    sBCC = Range("A46").Value 'Скрытая копия(можно заменить значением из ячейки - sBCC = Range("A1").Value)
    sSubject = Range("A47").Value  'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
    sBody = Range("A1:K41").Value  'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
             
            
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .BCC = sBCC 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .Body = sBody 'текст сообщения
        '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
        .Display 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
    End With
   
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub
 
Перейти    
Отправка писем. Как проверить, существует ли по ссылке файл для отправки?
 
#
20.08.2020 18:20:26
Код
lLastR = Cells(Rows.Count, 1).End(xlUp).Row 'определяем последнюю заполненную ячейку в столбце А
    'цикл от второй строки(начало данных с адресами) до последней ячейки таблицы
    For lr = 2 To lLastR
        Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
        'создаем сообщение
        With objMail
            .To = Cells(lr, 1).Value 'адрес получателя
            .CC = Cells(lr, 2).Value 'копия
            .BCC = Cells(lr, 3).Value 'адрес для скрытой копии
            .Subject = Cells(lr, 4).Value 'тема сообщения
            .Attachments.Add Cells(lr, 5).Value
            .Body = Cells(lr, 6).Value 'текст сообщения
            .Display 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
        End With
    Next lr
          
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub
Подскажите команду, которая пропускает макрос без вложения, чтобы создавались письма с вложениями и без, команда .Attachments.Add  - обязывает нахождение какого-либо вложения, иначе макрос перестаёт работать !

Может есть какая-нибудь команда по типу If attachements not founed - Continue
 
Перейти    
[ Закрыто] Создаём 2 разных сообщения ОДНИМ макросом
 
#
19.08.2020 18:16:04
Добрый вечер, подскажите, пожалуйста, где ошибка, пытаюсь одним макросом создать 2 сообщения, но создается только одно, сутки пытаюсь перестроить макрос, но безрезультатно....возможно ли вообще такое ??
Код
Sub sendmail()

Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
      
    Application.ScreenUpdating = False
    
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    objOutlookApp.Session.Logon
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
  
    sTo = Range("B1").Value  'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
    sCC = Range("B2").Value  'Копия(можно заменить значением из ячейки - sCC = Range("A1").Value)
    sBCC = Range("B3").Value 'Скрытая копия(можно заменить значением из ячейки - sBCC = Range("A1").Value)
    sSubject = Range("B5").Value  'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
    sBody = Range("B7").Value  'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
             
            
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .CC = sCC 'адрес для копии
        .BCC = sBCC 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .Body = sBody 'текст сообщения
        '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.
        .Display 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
    End With
    
    Set objMail = objOutlookApp.CreateItem(1)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
  
    sTo = Range("С1").Value  'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
    sCC = Range("С2").Value  'Копия(можно заменить значением из ячейки - sCC = Range("A1").Value)
    sBCC = Range("С3").Value 'Скрытая копия(можно заменить значением из ячейки - sBCC = Range("A1").Value)
    sSubject = Range("С5").Value  'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
    sBody = Range("С7").Value  'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
             
            
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .CC = sCC 'адрес для копии
        .BCC = sBCC 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .Body = sBody 'текст сообщения
        '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.
        .Display 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
    End With
   
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub
Изменено: Andrey Melnikov - 19.08.2020 18:25:52
 
Перейти    
Массовая рассылка писем по адресам при помощи Outlook
 
#
10.08.2020 10:54:12
Добрый день, подскажите, пытаюсь создать несколько сообщений в 1 макросе (необходимо 10 сообщений - 1 макросом), но ничего не выходит, ниже код, пытаюсь изначально сделать хотя бы 2 сообщения в связке, пожалуйста подскажите

Код
Sub Send_Mail()
    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
 
    Application.ScreenUpdating = False
    On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    objOutlookApp.Session.Logon
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
 
    sTo = Range("B1").Value  'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
    sCC = Range("B2").Value 'Копия(можно заменить значением из ячейки - sBCC = Range("A1").Value)
    sBCC = Range("B3").Value 'Скрытая копия(можно заменить значением из ячейки - sBCC = Range("A1").Value)
    sSubject = Range("B5").Value  'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
    sBody = Range("B7").Value  'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
           
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .CC = sCC 'адрес для копии
        .BCC = sBCC 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .Body = sBody 'текст сообщения
        '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
        'добавляем вложение, если файл по указанному пути существует(dir проверяет это)
        If Dir(sAttachment, 16) <> "" Then
            .Attachments.Add sAttachment 'просто вложение
            'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
        End If
        .Display 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
    End With
  
Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
 
    sTo = Range("B1").Value  'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
    sCC = Range("B2").Value 'Копия(можно заменить значением из ячейки - sBCC = Range("A1").Value)
    sBCC = Range("B3").Value 'Скрытая копия(можно заменить значением из ячейки - sBCC = Range("A1").Value)
    sSubject = Range("B5").Value  'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
    sBody = Range("B7").Value  'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
           
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .CC = sCC 'адрес для копии
        .BCC = sBCC 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .Body = sBody 'текст сообщения
        '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
        'добавляем вложение, если файл по указанному пути существует(dir проверяет это)
        If Dir(sAttachment, 16) <> "" Then
            .Attachments.Add sAttachment 'просто вложение
            'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
        End If
        .Display 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
    End With
  
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub
 
Перейти    
Страницы: 1
Наверх