Страницы
Контакты
Прочее
© 2016 Open Notes. При использовании материалов сайта ставьте ссылку на opennotes.ru
Получать информацию о выполненных и будущих задачах, распланированных в соответствующем разделе Outlook, можно с помощью кода из этой статьи. Может, например, пригодиться для автоматического формирования перечня задач находящихся в работе и уже исполненных.
Private Sub LoadTask() Dim fTasks As Outlook.MAPIFolder Dim Tasks As Outlook.Items Set fTasks = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderTasks) Set Tasks = fTasks.Items Tasks.Sort "[StartDate]", True For i = 1 To Tasks.Count 'Тема задачи ActiveSheet.Range("A" & i).Value = _ Replace(Trim(Tasks(i).Subject), Chr(10), " ") 'Статус задчи If Tasks(i).Complete Then ActiveSheet.Range("B" & i).Value = "Завершена" Else ActiveSheet.Range("B" & i).Value = "В работе" End If 'Тип задчи If Tasks(i).IsRecurring Then ActiveSheet.Range("C" & sr).Value = "Регулярная задача" Else ActiveSheet.Range("C" & sr).Value = "Единичная задача" End If ActiveSheet.Range("D" & sr).Value = Tasks(i).StartDate 'Срок окончания задачи ActiveSheet.Range("E" & sr).Value = Tasks(i).DueDate 'Дата выполнения ActiveSheet.Range("F" & sr).Value = Tasks(i).DateCompleted 'Описание задачи ActiveSheet.Range("G" & sr).Value = Tasks(i).Body ActiveSheet.Range("H" & sr).Value = Tasks(i).Owner Next i End Sub |
Продолжить чтение »
Следующий код, помещённый в VBA редакторе на соответствующий лист, позволяет двойным кликом левой кнопки мыши по ячейке в первом столбце устанавливать в ней попеременном галочку, либо крестик.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) With Target If .Column = 1 Then Select Case .Value Case Is = "a" .Font.Name = "Marlett" .Value = "r" Case Is = "r" .Font.Name = "Marlett" .Value = "a" Case Else .Font.Name = "Marlett" .Value = "a" End Select Cancel = True End If End With End Sub |
Результат работы макроса выглядит следующим образом:
Если, например, требуется получить одно единственное значение с помощью запроса к базе данных (сам запрос может иметь заранее заданную конструкцию, меняющуюся в зависимости от определённых условий), то пригодится следующией код.
Для MS SQL
Sub Get_MSSQL_Data() Dim db As ADODB.Connection Dim rs As ADODB.Recordset Dim sqlStr As String Set rs = CreateObject("ADODB.Recordset") Set db = New ADODB.Connection db.Open _ "DRIVER={SQL Server};SERVER=SName;UID=UserName;PWD=Password;DATABASE=DBName" sqlStr = "SELECT Count(*) as cnt FROM [DBName].[DB].[Table]" rs.Open sqlStr, db While Not rs.EOF str1 = rs.Fields("cnt").Value rs.MoveNext Wend rs.Close db.Close End Sub |
Продолжить чтение »
Задача: Есть набор целых чисел (числа не повторяются)
1 3 5 7 8 9 11 2 25 30 |
Необходимо в Excel написать макрос, который выводит на лист «Результат» все комбинации чисел из набора, дающие в сумме 40. Каждое число можно использовать один раз. Полный перебор комбинаций нежелателен.
Дано: Книга Excel, сотоящая из двух листов. На первом листе (sh1) во второй строке располагается набор целых чисел, а в четвертой строке – необходимая сумма. На втором листе (sh2) будут хранится временные массивы и итоговый результат.
Продолжить чтение »
Создание примечания для ячейки в Excel с помощью макроса, которое также имело бы сложное внутреннее форматирование, не самая тривиальная задача. Для этого можно воспользоваться например таким кодом:
With Worksheets(1).Cells(4, 12).Comment .Visible = False .Text "Жирный шрифт:" & Chr(10) & "курсив" .Shape.DrawingObject.Characters(1, 13).Font.Bold = True .Shape.DrawingObject.Characters(15, 20).Font.Italic = True End With |
В итоге получится примерно такое примечание:
Продолжить чтение »
При создании сохранении новой книги Excel может возникнуть сообщение:
Предупреждение о конфиденциальной информации: документ содержит макросы, элементы управления ActiveX, данные пакета расширения XML или веб-компоненты. Они могут включать личные сведения, которые нельзя удалить с помощью инспектора документов.
Решение проблемы:
- Откройте книгу в Excel.
- Откройте центр управления безопасностью в Excel.
- На вкладке Параметры конфиденциальности снимите флажок Удалять личные сведения из свойств файла при сохранении.
- Сохраните книгу и закройте Excel.
Чтобы в случае ввода ошибочных данных в таблицу Excel (например, слово вместо цифры в столбец «Номер») ячейки с ошибками подсвечивались красным фоном, можно воспользоваться условным форматированием. Данный способ удобнее, чем проверка данных, в случае массовой вставки данных из внешнего источника.
Для Excel 2010. Нужно открыть «Условное форматирование» -> «Управление правилами…» -> «Создать правило…» -> «Использовать формулу для определения форматируемых ячеек» и в поле «Форматировать значения, для которых следующая формула является истинной» ввести условие форматирования. Затем, с помощью кнопки «Формат…» выбрать способ подсветки значения.
Продолжить чтение »
В Excel 2010 нужно выбрать в меню Файл-> Параметры-> Формулы-> раздел: Работа с формулами-> Стиль ссылок R1C1.
Либо воспользоваться макросом:
Private Sub Change_ColStyle() If Application.ReferenceStyle = xlA1 Then Application.ReferenceStyle = xlR1C1 Else Application.ReferenceStyle = xlA1 End If End Sub |
Как изменить заголовки столбцов в Excel 2007 и 2003: Excel — это не сложно!
Продолжить чтение »
Задача переноса графиков, диаграмм, таблиц из Excel в презентацию PowerPoint осложняется тем, что в последних версиях редактора презентаций (2007, 2010) разработчики убрали возможность записи производимых действий в макрос. Поэтому, для настройки внешнего вида презентации под собственные условия, нужно перерыть документацию по VBA для PowerPoint, либо просмотреть множество специализированных форумов. Ниже приведен код примера создания презентации из диаграмм Excel.
Private Sub export_to_pp() Set pr = CreateObject("PowerPoint.Application") Set mpr = pr.Presentations.Add 'Определение имени создаваемой презентации ppName = "Имя_для_презентации" 'Добавление пустого слайда Set ppSlide = mpr.Slides.Add(mpr.Slides.Count, ppLayoutBlank) 'Цвет фона слайда ppSlide.Master.Background.Fill.ForeColor.RGB = RGB(200, 200, 200) 'Добавление блока (Orientation, Left, Top, Width, Height) 'функция Application.CentimetersToPoints переводит сантиметры в пиксели Set TextShape = ppSlide.Shapes.AddTextbox(1, _ Application.CentimetersToPoints(1.09), _ Application.CentimetersToPoints(1.2), _ Application.CentimetersToPoints(22.86), _ Application.CentimetersToPoints(1.2)) TextShape.TextFrame.TextRange.Text = "Текст надписи" 'Настройка параметров блока с текстом TextShape.TextFrame.TextRange.Font.Name = "Calibri" TextShape.TextFrame.TextRange.Font.Size = 18 TextShape.TextFrame.TextRange.Font.Bold = True 'Отключение автоматического подгона размера блока под текст TextShape.TextFrame.AutoSize = 0 TextShape.Height = Application.CentimetersToPoints(1.2) TextShape.TextFrame.TextRange.Font.Color = vbWhite 'Вертикальное выравнивание текста по центру TextShape.TextFrame.VerticalAnchor = msoAnchorMiddle 'Копируем диаграмму в PowerPoint ListName.ChartObjects("ChartName").Copy Set chart1 = ppSlide.Shapes.PasteSpecial(ppPastePNG) chart1.Left = Application.CentimetersToPoints(1.52) chart1.Top = Application.CentimetersToPoints(3.65) 'Копируем таблицу как OLE object ListName.Range("H51:M60").Copy Set table1 = ppSlide.Shapes.PasteSpecial(ppPasteOLEObject) table1.Left = Application.CentimetersToPoints(1.52) table1.Top = Application.CentimetersToPoints(13.72) 'Копируем таблицу как рисунок ListName.Range("H61:M70").Copy Set table2 = ppSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile) table2.Left = Application.CentimetersToPoints(13.16) table2.Top = Application.CentimetersToPoints(13.72) Application.CutCopyMode = False 'Сохраняем презентацию в папке с текущей книгой Excel mpr.SaveAs (ThisWorkbook.Path + "\" + ppName) mpr.Close pr.Quit End Sub |
Продолжить чтение »
При запуске файла из локальной или глобальной сети, содержащего макрос, может появляться данная ошибка. Причём ошибка появляется сразу же после нажатия кнопки «Разрешить редактирование» в сообщении «Защищенный просмотр».
При повторном запуске файла ошибка уже не возникает (как и не появляется сообщение о «Защищенном режиме»). При выяснении причины проблемы, дебаггер выделяет строчку в коде, отвечающую за активацию одного из листов книги Excel: Sheets("Лист 1").Activate.
Решение: в свойствах файла Excel на вкладке «Общие» нужно нажать кнопку «Разблокировать» рядом с предупреждением:
Задача: необходимость добавить к графику горизонтальную линию на уровне определенного значения одной из осей. Для решения этой задачи можно либо составить ряд одинаковых чисел и добавить соответствующий график на диаграмму, либо воспользоваться VBA:
Const Num = 0.8 'Значение уровня Dim objSeries As Series Dim arrValues() ActiveWorkbook.Sheets("Имя_листа").ChartObjects("Имя_диаграммы").Activate arrValues = ActiveChart.SeriesCollection(1).Values For i = LBound(arrValues) To UBound(arrValues) arrValues(i) = Num Next Set objSeries = ActiveChart.SeriesCollection.NewSeries objSeries.Values = arrValues objSeries.ChartType = xlLine |
Источник: Форум программистов
Продолжить чтение »
Пополняемый список полезных отрывков кода VBA для выполнения часто востребованных действий в MS Excel.
Служебные команды для ускорения скорости выполнения макроса:
'Отключение отображения выполняемых действий Application.ScreenUpdating = False 'Предотвращение появления предупреждающих сообщений Application.DisplayAlerts = False 'Предотвращение появления предупреждения об обновлении связей данных Application.AskToUpdateLinks = False 'Очистка буфера обмена Application.CutCopyMode = False |
Продолжить чтение »
Если после выполнения макроса необходимо отправить в качестве вложения получившийся документ Excel, можно использовать следующий код. Он создаёт письмо с нужным перечнем адресатов в полях «Кому» и «Копия», с указанной темой, текстом и прикреплённым Excel файлом. Остаётся толкьо дописать письмо в случае необходимости и нажать кнопку «Отправить».
Dim OutlookApp As Object, SM As Object Set OutlookApp = CreateObject("Outlook.Application") Set SM = OutlookApp.CreateItem(olMailItem) 'SM.SentOnBehalfOfName = "mail@example.ru" 'Поле "От", если нужен другой отправитель SM.To = "mail@example.ru" 'Поле "Кому" SM.CC = "mail@example.ru" 'Поле "Копия" SM.Subject = "Тема письма" On Error Resume Next SM.Body = "Текст письма" SM.Attachments.Add ("C:\Test.xls") 'Адрес вложения SM.Display Set SM = Nothing Set OutlookApp = Nothing |
Продолжить чтение »
