Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Счет значений в поле с объединенными и отдельными ячейками по условиям в поле с отдельными ячейками
 
Здравствуйте! Помогите, пожалуйста. Нужно формулой сосчитать количество значений в поле "Значение" (диапазон "Значение") с объединенными и отдельными ячейками, если в поле "Отметка" (диапазон "Отметка") с отдельными ячейками заполнены все ячейки в пределах диапазона строк считаемой ячейки.
Счет ячеек с датами по количеству оставшихся рабочих дней
 
Здравствуйте.Помогите, пожалуйста, с формулой. В именованном диапазоне «КС» указаны даты. Нужно сосчитать в «КС» количество ячеек, в которых до указанных в них дат остался один рабочий день. Формула СУММПРОИЗВ(--(РАБДЕНЬ(СЕГОДНЯ();0)=КС)) считает только рабочие даты, даты суббот и воскресений из счета выпадают, а хотелось бы, чтобы в пятницу, если в КС указана дата субботы или воскресенья, формула считала бы, что остался один рабочий день.
Изменено: Павел Запивахин - 20.08.2019 08:35:48
Проверка ссылки на абзац в OneNote
 
Здравствуйте, уважаемые форумчане. Подскажите, пожалуйста, как vba-кодом проверить работоспособность  ссылки на абзац страницы OneNote.
Код
Sub Гиперссылка()

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"onenote:///C:\Users\Павел_А\Documents\Записные%20книжки%20OneNote\Записная%20книжка%202019\Задачи\Задачи%202.one" _
, SubAddress:= _
"МояЗадача§ion-id={3A354F2D-F136-473D-8B62-1C1AD390B89D}&page-id={1CF9327F-4D7A-48CF-9E0C-7A323BB268EB}&object-id={5B5B808E-1" _
, TextToDisplay:="МояЗадача"

End Sub
Проверка наличия защиты общей книги
 
Здравствуйте. Подскажите, пожалуйста, как перед снятием защиты с общей книги (ActiveWorkbook.UnprotectSharing "123") проверить наличие защиты?
Вставка макросом условного форматирования на изменение значения в ячейке
 
Здравствуйте! Задумка такая: перед отправкой файла для актуализации данных вставить в выделенные ячейки УФ, которое будет закрашивать ячейки, если в них будут внесены изменения, затем сохранить книгу без поддержки макросов и отправить файл почтой. Записал макрорекодером макрос, немного его подправил:
Код
Sub УФ() ' если выделенные ячейки будут изменены, то они зальются красным
Dim iCell As Range

Cells.FormatConditions.Delete
For Each iCell In Selection
    If Not IsEmpty(iCell) Then
        If IsNumeric(iCell.Value) Then
            iCell.FormatConditions.Add Type:=xlExpression, Formula1:="=" & iCell.Address & "<>" & iCell.Value
        Else
            iCell.FormatConditions.Add Type:=xlExpression, Formula1:="=" & iCell.Address & "<>""" & iCell.Text & """"
        End If
    Else
        iCell.FormatConditions.Add Type:=xlExpression, Formula1:="=НЕ(ЕПУСТО(" & iCell.Address & "))"
    End If
    iCell.FormatConditions(iCell.FormatConditions.Count).SetFirstPriority
    With iCell.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    iCell.FormatConditions(1).StopIfTrue = False
Next
End Sub
Макрос работает, но запинается на ячейках, в которых текст содержит кавычки. Подскажите, пожалуйста, как быть с кавычками в тексте без их удаления?
И второй вопрос: как в ячейке определить событие срабатывания УФ (не наличие УФ в ячейке, а то что ячейка закрасилась)?
Загрузка файлов с сайта в Windows7 + Office2013
 
Здравствуйте. На компьютере (ХР, Office2007, пользователь)  скачивал файлы с сайта макросом:
Код
Sub loadFile()
    Dim fPath As String
    Dim oXMLHTTP As Object
    Dim oADOStream As Object
    
    fPath = ActiveWorkbook.Path
    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    'подключение
'    .Open "POST", sURL, False, "login", "password" ' не требуется, аутентификация по IP
    oXMLHTTP.Open "GET", "http://IP-адрес_сервера/index.php?option=com_docman&task=doc_download&gid=35&Itemid", 0 ' URL адрес для загрузки
    'получение файла
    oXMLHTTP.Send
    Set oADOStream = CreateObject("ADODB.Stream")
    oADOStream.Mode = 3 'разрешение на чтение и запись
    oADOStream.Type = 1 'тип данных - Binary
    oADOStream.Open
    oADOStream.Write oXMLHTTP.responseBody
    'сохранение (с перезаписью файла при необходимости)
    oADOStream.SaveToFile fPath & "\FilesForProcessing\имя_файла.xlsm", 2 ' путь для сохранения файла, 2 - перезапись файла
End Sub
После замены компьютера (Windows7, Office2013, пользователь) файлы перестали скачиваться, вместо файлов скачивается страница сайта. Как восстановить загрузку файлов?
Счет значений за неделю по трем условиям
 
Здравствуйте! Можно ли упростить формулу подсчета значений за неделю с тремя условиями? Формула и пояснения во вложенном файле.
Ошибка "Метод или элемент данных не определен"
 
Здравствуйте! Уже давно (ОС ХР, Excel2007) скачиваю файл xlsm с корпоративного сайта и макросом беру из него нужные данные. Вчера этот файл начал открываться с ошибкой и останавливать мой макрос. Ошибка появляется в Private Sub Workbook_Open() на строке Лист1.TextBox1.Visible = False. Прошел поиском по всему проекту - имена Лист1 и TextBox1 переменным не назначены. Такого обращения к листу и фигуре я еще не видел и до сегодняшнего дня считал , что нужно обращаться: Sheets("Лист1".Shapes("TextBox1"). Открыл этот файл в Windows7 Excel2010 - открывается без ошибок. Позвонил автору этого файла, он говорит, что в ОС ХР, в Excel2007 у него ошибок при открытии нет. Помогите, пожалуйста, устранить эту ошибку.
После копирования макросом листа в новую книгу и сохранения в списке допустимых значений запятая заменяется точкой с запятой
 
Здравствуйте! При написании макроса столкнулся с проблемой, которую повторил во вложенной книге. На листе имеются ячейки с проверкой допустимых значений: А;Б, В;Г. Второе значение содержит запятую. Включаю макрорекодер, копирую лист в новую книгу, сохраняю ее, закрываю и выключаю макрорекодер. На листе сохраненной книги изменений нет. Удаляю сохраненную книгу. Запускаю записанный макрос, открываю книгу, созданную и сохраненную макросом, и вижу, что в списке допустимых значений вместо трех значений уже четыре - запятая второго значения заменяется разделителем точкой с запятой и второе значение разбивается на два: А;Б;В;Г. Можно ли как-то решить эту проблему?
Изменено: Павел Запивахин - 12.11.2014 18:55:34
Заполнить коллекцию значениями поля форматированной (умной) таблицы
 
Здравствуйте! Подскажите, пожалуйста, можно ли как-то заполнить коллекцию значениями поля форматированной (умной) таблицы, используя обращение к полю таблицы в формате Таблица1[Название поля]?
Просмотр листов книги при активной динамической форме
 
Здравствуйте. При запуске макроса формируется динамическая UserForm1 со списком имен листов активной книги с чекбоксами для выбора листов, которые следует удалить. Как сделать так, чтобы при активной UserForm1 активировать выбор листов книги и полосы прокрутки для просмотра содержимого листов, как при Set myRange = Application.InputBox(prompt:="Выбери диапазон", Type:= 8) ?
Копировать кэш сводной таблицы в буфер обмена
 
Здравствуйте. Подскажите, пожалуйста, как макросом скопировать кэш сводной таблицы в буфер обмена или где можно об этом прочесть.
Кто и когда последним сохранил файл в сетевой папке
 
Здравствуйте. В сетевой папке размещены файлы без общего доступа, которые заполняются разными пользователями. Можно ли вычислить имя пользователя, который последним сохранил файл? В чем разница при определении времени последнего сохранения файла между FileDateTime(fPath) и DateLastModified FSO?
Сосчитать ячейки с формулами, значения в которых не равны ""
 
Здравствуйте. Как задать условие для подсчета ячеек с формулами, значения в которых не равны ""? В ячейке С1 формула считает правильно, но хотелось бы использовать одну функцию СЧЁТЕСЛИ.
Вычислить координаты ячейки
 
Здравствуйте! Макрос создания кнопки:
Код
Sub Btn()
    With ActiveSheet.Buttons.Add(Left:=200, Top:=100, Width:=125, Height:=40)
     .Name = "Button 1"
     .Text = "Добавить столбцы"
     .OnAction = "addCol"
    End With
End Sub
Хочу вставить кнопку на первую пустую ячейку строки с заголовком таблицы. Можно ли вычислить координаты (Left и Top) ячейки?
Показать выбранный столбец в стиле А1
 
Здравствуйте! В MsgBox отображается номер выбранного столбца:
If MsgBox("Вы выбрали столбец : " & selectedCell.Column & ". Продолжить ?", vbYesNo + vbQuestion, "Выбор столбца" = vbNo Then Exit Sub
Как показать выбранный столбец в стиле А1 без создания дополнительного массива или коллекции?
Условие, что размерность динамического массива не определена
 
Здравствуйте. Как задать условие, что размерность динамического массива не определена?
Option Base 1
Sub qqq()
Dim myArray()
   If "размерность массива не определена" Then
 ReDim myArray(1 To 1)
   Else
 ReDim Preserve myArray(1 To UBound(myArray) + 1)
   End If
End Sub
Отследить нажатие программно созданной кнопки
 
Здравствуйте! В форме программно пытаюсь создать кнопку. Кнопка создается, но не могу отследить ее нажатие. В строке With Me.CodeModule выдает ошибку: метод или элемент данных не определен. Прошу помощи в решении возникшей проблемы.
Код
Private Sub UserForm_Initialize()
   With Me.Controls.Add(bstrProgID:="Forms.CommandButton.1")
         .Name = "CommandButton1"
         .Left = 190
         .Top = 20
         .Height = 24
         .Width = 78
         .Caption = "Отменить"
    End With
    
    With Me.CodeModule
        Line = .CountOfLines
        .InsertLines Line + 1, "Sub CommandButton1_Click()"
        .InsertLines Line + 2, "НажатиеКнопки1"
        .InsertLines Line + 3, "End Sub"
    End With
End Sub

Sub НажатиеКнопки1 ()
    MsgBox "Кнопка нажата"
    UserForm5.Hide
End Sub
Переименование папки макросом
 
Здравствуйте! Прошу помочь в решении возникшей проблемы. Рядом с файлом лежит папка «Бланки», в ней находятся папки с файлами (в прилагаемых макросах – «Старое имя папки» и «Файл с данными»). Необходимо на основании данных из файлов сформировать имена (Link) и присвоить их родительским папкам («Старое имя папки» заменить на Link). Первый макрос, где я конкретно прописываю FilePath, работает. Во втором макросе я пытаюсь взять путь к файлу из диалога GetOpenFilename, VBA на строке переименования выдает ошибку: Run-time error ‘75’: Path/file access error. Подскажите, пожалуйста, что делаю не так?
И еще один вопрос. Если во втором макросе переменной FilePath присвоить тип String, то на строке If FilePath = False Then появляется ошибка о несоответствии типа переменной, а тип Variant пропускает. Как правильно вычислить, что в диалоговом окне файл не был выбран?
Макрос, который работает:
Код
Sub Работает()
Dim FilePath As String
Dim FolderPath As String
Dim FolderName As String
Dim iExtension As String
Dim link As String ' новое имя папки
Dim check As Boolean
       
FilePath = "C:\Users\Павел\Desktop\БЗ\Бланки\Старое имя папки\Файл с данными.doc"

iExtension = CreateObject("Scripting.FileSystemObject").GetExtensionName(FilePath) ' Расширение файла
FolderPath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(FilePath) ' Имя родительской папки
FolderName = Replace(FolderPath, ThisWorkbook.Path & "\" & "Бланки" & "\", "") ' Имя папки для TextToDisplay гиперссылки
link = "Новое имя папки"
Name FolderPath As ThisWorkbook.Path & "\Бланки\" & link
End Sub

Макрос, который не работает:
Код
Sub Не_работает()
Dim FilePath As Variant
Dim FolderPath As String
Dim FolderName As String
Dim iExtension As String
Dim WordApp As Object, CopyArea As Variant
Dim link As String ' новое имя папки
Dim check As Boolean
   
ChDir ThisWorkbook.Path & "\" & "Бланки" & "\" ' Путь к папкам с бланками-заказами
FilePath = Application.GetOpenFilename("all Files (*.*), *.*", Title:="Выберите файл") ' Диалог выбора файла
If FilePath = False Then 'Если файл не выбран, то сбрасывается check, выводится сообщение и выход
    check = False
    MsgBox "Файл не выбран!", 48, "ВНИМАНИЕ!"
    Exit Sub
End If

iExtension = CreateObject("Scripting.FileSystemObject").GetExtensionName(FilePath) ' Расширение файла
FolderPath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(FilePath) ' путь к родительской папке
FolderName = Replace(FolderPath, ThisWorkbook.Path & "\" & "Бланки" & "\", "") ' Имя папки для TextToDisplay гиперссылки
link = "Новое имя папки" ' в данном макросе равно FolderName
Name FolderPath As ThisWorkbook.Path & "\Бланки\" & link
End Sub
Отображение на экране правого или нижнего краев таблицы при открытии книги
 
Здравствуйте!
Как сделать так, чтобы в сформированной и сохраненной макросом книге при открытии и выборе листов на экране отображались последний столбец или последняя строка? В макросе делаю выделение ячеек в последнем столбце или последней строке, но при открытии книги и выборе листов выбранные ячейки находятся за пределами экрана. Без отключения обновления экрана выделенные ячейки на экране видны, а с отключением их не видно.

Sub MyReport()

Application.ScreenUpdating = False

' Здесь формируется книга

' Для листов с широкими (по столбцам) таблицами
LastCol = ReportSheet.Cells(2, Columns.Count).End(xlToLeft).Column
ReportSheet.Cells(2, LastCol).Select

' Для листов с длинными (по строкам) таблицами
LastRow = ReportSheet.UsedRange.Rows.Count + ReportSheet.UsedRange.Row - 1
ReportSheet.Range("A" & LastRow).Activate

Report.SaveAs Filename:=ThisWorkbook.Path & "\Ежедневные отчеты\" &_
Format(strDate, "yyyy.mm.dd" ;)  & " Название отчета.xlsx.", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ' Сохраняю книгу с отчетом
Application.Workbooks(Report.Name).Close 'Закрываю отчет
Application.ScreenUpdating = True

End sub
Проверка факта отправки файла (сообщения) электронной почтой
 
Здравствуйте!
Отправка файла электронной почтой осуществляется макросом:

Sub SendWR ()

Dim fileToSend As Variant

ChDir ThisWorkbook.Path & "\ Недельные отчёты\"
fileToSend = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", Title:="Выбор файла недельного отчета для отправки" ;)
If fileToSend = False Then
check = True
MsgBox "Файл для отправки не выбран!", 48, "ВНИМАНИЕ!"
Exit Sub
End If
' Отправка отчёта электронной почтой
Dim objOL As New Outlook.Application
Dim objMail As MailItem
Dim objAttach As Outlook.Attachments
Dim MailingAddresses As String
Set objOL = New Outlook.Application
Set objMail = objOL.CreateItem(olMailItem)
Set objAttach = objMail.Attachments

Call AdrOnSheet ' Сборка адресов с листа "Доп"

With objMail
.To = MailingAddresses
.Body = "Недельный отчёт"
.Subject = "Недельный отчёт "
.Display
End With
objAttach.Add (fileToSend)
Set objMail = Nothing
Set objOL = Nothing
Set objAttach = Nothing
ThisWorkbook.Sheets("Доп" ;) .Range("E12" ;)  = Date ' Здесь нужна проверка отправки сообщения

End Sub

Открывшееся окно отправки со вложенным файлом можно отправить, а можно просто закрыть.
Возможно ли проверить факт отправки этого сообщения?
Предварительный выбор файлов в Application.GetOpenFilename
 
Здравствуйте! Можно ли в Application.GetOpenFilename с мультивыбором сделать предварительный выбор файлов, чтобы при открытии окна в нем уже были выделены нужные файлы?
Сохранить неизменным именованный диапазон при удалении строк
 
Здравствуйте!  
Имеется именованный диапазон "диапазон" в А1:А20. При удалении строк из этого диапазона он уменьшается на количество удаленных строк. Для его восстановления в модуль листа вставил:  
Private Sub Worksheet_Change(ByVal Target As Range)  
 ActiveWorkbook.Names.Add Name:="диапазон", RefersToR1C1:="=Лист1!R1C1:R20C1"  
End Sub  
Можно ли как-то по другому определить событие удаления строк из именованного диапазона?
Заменить макрос поиска в поле слов из списка формулой
 
Для поиска в поле слов из списка пользуюсь макросом:  
Sub SearchStr()  
   Dim i As Long, mArr()    ' Массив искомых слов  
   Dim iLastRowTab As Long  ' Последняя строка в поле поиска  
   Dim iLastRowSp As Long   ' Последняя строка в поле со списком искомых значений  
   Dim n As Long            ' Строка поиска  
   Dim m As Long            ' Размерность массива  
   Dim strF As String  
     
   Sheets("Перечень").Select  
   iLastRowSp = Sheets("Перечень").Cells(Rows.Count, 1).End(xlUp).Row  
   For i = 1 To iLastRowSp  
       ReDim Preserve mArr(i - 1)    'переопределение размерности массива  
       mArr(i - 1) = Sheets("Перечень").Cells(i, 1).Text  'занесение данных в массив  
   Next i  
   m = iLastRowSp - 1  
   Sheets("Лист1").Select  
   iLastRowTab = Cells(Rows.Count, 1).End(xlUp).Row  
   For n = 1 To iLastRowTab  
       For i = 0 To m  
           strF = LCase(mArr(i))  
           If LCase(Cells(n, 1)) Like "*" & strF & "*" Then Cells(n, 2) = "Есть"  
       Next i  
   Next n  
End Sub  
Уважаемые формулисты, подскажите пожалуйста, формулу для замены макроса.
Проверить комбобоксы и текстбоксы на Empty
 
Как покороче можно проверить комбобоксы и текстбоксы на Empty или "", без создания в If - Then длинной связки через And, для того, чтобы запретить по нажатию CommandButtonОК создание записи с пустыми полями?
Исключить ввод с клавиатуры в книге с общим доступом
 
Записи на лист заносятся через форму ввода, которая открывается через Worksheet_SelectionChange. После ввода данных и закрытия формы в активную ячейку можно с клавиатуры ввести данные. Для того, чтобы это исключить, установил защиту листа, которая перед записью значений из формы снимается и затем снова устанавливается:    
Private Sub CommandButton1_Click()  
   ' Здесь проверка корректности данных  
----------------------------------------------  
       Application.DisplayAlerts = False  
       ThisWorkbook.Save  
       Application.DisplayAlerts = True  
       SelRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count  
   End If  
   Sheets("Оборудование").Unprotect "qwerty"  
   With Worksheets("Оборудование")  
       Cells(SelRow, 1) = Me.ComboBox1.Value  
-----------------------------------------------  
       Cells(SelRow, 12) = Me.TextBox7.Value  
       If Cells(SelRow, 2) <> "" And Cells(SelRow, 3) <> "" And Cells(SelRow, 4) <> "" And Cells(SelRow, 5) <> "" Then ' Если заполнены все ячейки с датами и временем  
           Cells(SelRow, 6) = "=RC[-2]-RC[-4]+RC[-1]-RC[-3]" ' Формула длительности повреждения
           Cells(SelRow, 6).NumberFormat = "[h]:mm" ' Часы с учетом количества суток и минуты
       Else  
           Cells(SelRow, 6) = "" ' Если заполнены не все ячейки с датами и временем, то ""  
       End If  
   End With  
   UserForm3.Hide  
   Sheets("Оборудование").Protect "qwerty"  
   Application.DisplayAlerts = False  
   ThisWorkbook.Save ' Сохранение книги с изменениями  
   Application.DisplayAlerts = True  
End Sub  
С монопольным доступом работает, а вот при включении общего доступа выходит ошибка "Метод Unprotect из класса Worksheet завершен неверно", похоже, что общий доступ не предполагает защиту листа. Как исключить возможность ввода отсебятины с клавиатуры в активную ячейку после закрытия формы?
Контроль отправки почты
 
Макрос вызывает окно отправки MS Outlook. Можно ли проследить закрытие окна отправки нажатием на крестик.
Количество строк в объединенной ячейке
 
Ячейка объединена по строкам. Требуется макросом узнать количество строк в объединенной ячейке.  
ТурбоЕж выкладывал решение с использованием ЧСТРОК и пользовательской функции смещения от объединенной ячейки:  
Function мсмещ(rowoffset As Long, collumnoffset As Long) As Variant  
Dim mrng As Range  
Application.Volatile  
If Application.ThisCell.MergeCells Then  
   Set mrng = Application.ThisCell.MergeArea.Offset(rowoffset, collumnoffset)  
   Set mrng = mrng.Resize(Application.ThisCell.MergeArea.Rows.Count, 1)  
Else  
   Set mrng = Application.ThisCell.Offset(rowoffset, collumnoffset)  
End If  
 
If Application.Intersect(mrng, Application.ThisCell) Is Nothing Then  
   мсмещ = mrng  
Else  
   мсмещ = CVErr(xlErrRef)  
End If  
End Function  
Проблема в том, что объединенные ячейки встречаются где попало и невозможно задать смещение, а с нулевым смещением функция выдает ошибку.  
Можно ли доработать эту функцию для нулевого смещения или через свойства объединенной ячейки вычислить количеств строк в ней?
Выделить лист из файла, скачанного из web
 
Макрос скачивает из сети файл и сохраняет его. Файл - книга Excel. Можно ли без сохранения файла выделить из него лист для сохранения в книге из которой вызывался макрос?  
Sub load_file()  
'Создаем объект XMLHTTP  
Dim oXMLHTTP As Object  
Dim oADOStream As Object  
Dim fPath As String  
 
fPath = ActiveWorkbook.Path                 'Путь к файлу  
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")  
'подключение  
oXMLHTTP.Open "GET", "http://www.planetaexcel.ru/docs/forum_upload/post_146257.xls", 0 '<- Здесь укажи URL адрес для загрузки  
'получение файла  
oXMLHTTP.Send  
Set oADOStream = CreateObject("ADODB.Stream")  
oADOStream.Mode = 3 'разрешение на чтение и запись  
oADOStream.Type = 1 'тип данных - Binary  
oADOStream.Open  
oADOStream.Write oXMLHTTP.responseBody  
'сохранение (с перезаписью файла при необходимости)  
oADOStream.SaveToFile fPath & "\Файл из Интернета.xls", 2 '<- Здесь укажи путь для сохранения файла  
MsgBox "Файл сохранён в текущую папку."  
 
End Sub
Страницы: 1
Наверх