Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 126 След.
Защита листа и возможность редактировать диапазон
 
Цитата
Ігор Гончаренко написал: это судоку
Добрый вечер, Игорь!
Про судоку вроде была другая тема, и не одна.
Мой пример относился лишь к вопросу темы.
Vladimir Zakharov
Microsoft MVP – Excel
Защита листа и возможность редактировать диапазон
 
Например, так?
Vladimir Zakharov
Microsoft MVP – Excel
Обернуть полужирный текст в ячейке тегом strong, Нужно найти в ячейке текст, выденный полужирным шрифтом и заключить его в тег strong
 
Цитата
hilf написал: Просто интересно, откуда берется мусор.
Ответил выше - форматирование может выполняться стилями, тогда вместо поиска "<Cell>" нужен поиск "<Cell"
Vladimir Zakharov
Microsoft MVP – Excel
Обернуть полужирный текст в ячейке тегом strong, Нужно найти в ячейке текст, выденный полужирным шрифтом и заключить его в тег strong
 
Цитата
hilf написал: Когда я использую вашу функцию, вылазит какой-то мусор, лишние пробелы и переводы строк. Прилагаю файл с примером
Подправил код в сообщении #16 и вложение в сообщении #17, чтобы учитывать форматирование стилями.
Вариант Андрея в сообщении #22 - замечательный. Если другое форматирование не мешает, то можно использовать его, но не в формулах ячеек (UDF).
Vladimir Zakharov
Microsoft MVP – Excel
Обернуть полужирный текст в ячейке тегом strong, Нужно найти в ячейке текст, выденный полужирным шрифтом и заключить его в тег strong
 
Доброе утро, Игорь и Андрей! Да я и сам когда-то (апрель 2015г.) случайно в VBE Object Browser-е по F2 это обнаружил и поэкспериментировал. Вот, пригодилось :)
Vladimir Zakharov
Microsoft MVP – Excel
Обернуть полужирный текст в ячейке тегом strong, Нужно найти в ячейке текст, выденный полужирным шрифтом и заключить его в тег strong
 
Приложил пример, там есть и вспомогательная процедура TimeTest для проверки времени обработки
P.S. Обновил архив - учтено форматирование стилями
Изменено: ZVI - 13 Ноя 2017 14:21:00
Vladimir Zakharov
Microsoft MVP – Excel
Обернуть полужирный текст в ячейке тегом strong, Нужно найти в ячейке текст, выденный полужирным шрифтом и заключить его в тег strong
 
Посимвольное считывание и анализ свойств символов ячейки из объектной модели Excel в объектную модель VBA, как известно - медленный процесс.
Впрочем, и все другие процессы взаимодействия VBA с Excel медленные, и это проявляется тем заметнее, чем больше таких взаимодействий, как в данном случае.
Поэтому предлагаю считать в VBA XML-код ячейки с тэгами форматирования с помощью специального параметра при Value и обработать этот код в VBA. Кто не знает - у свойства .Value есть необязательный параметр [RangeValueDataType], который может принимать 3 значения:
Const xlRangeValueDefault = 10 - это то, что возвращается и без параметра;
Const xlRangeValueMSPersistXML = 12 - это XML код без тэгов форматирования;
Const xlRangeValueXMLSpreadsheet = 11 - это XML код с тэгами форматированием, т.е. то, что нам и нужно.

Вот быстрый код пользовательской функции, которая выдает значение ячейки с выделением участков жирного шрифта тэгами strong:
Код
Function BoldToStrong(Cell As Range) As String
' ZVI:2017-11-13 http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=readTID=98053
' Аргумент  - ссылка на ячейку Cell
' Результат - значение ячейки Cell с выделениями участков жирного шрифта XML-тэгами strong
' Пример VBA: Debug.Print BoldToStrong(Range("A1"))
' Пример формулы Excel: =BoldToStrong(A1)

  Dim a As Variant
  Dim s As String
  Dim i As Long, j As Long
  
  ' Использовать .Value c параметром [RangeValueDataType] для получения XML значения ячейки
  s = Cell.Item(1).Value(xlRangeValueXMLSpreadsheet)
  
  ' Выделить XML-часть ячейки
  i = InStr(s, "<Cell>") + 6
  If i = 6 Then i = InStr(s, "<Cell") + 6 ' Добавлено из-за стилей
  j = InStr(i, s, "</Cell>")
  s = Mid$(s, i, j - i)
  
  ' Заменить тэги начала и конца жирного шрифта на временные символы
  s = Replace(s, "<B>", Chr$(1))
  s = Replace(s, "</B>", Chr$(2))
  
  ' Избавиться от всех тэгов и их значений, кроме текста ячейки и временных символов
  a = Split(s, "<")
  For i = 0 To UBound(a)
    a(i) = Mid(a(i), InStr(a(i), ">") + 1)
  Next
  s = Join(a, vbNullString)
  
  ' Заменить временные символы на тэги strong
  s = Replace(s, Chr$(1), "<strong>")
  s = Replace(s, Chr$(2), "</strong>")
  
  ' Преобразовать обратно коды перевода строки, кавычек и т.п. (если это нужно)
  s = Replace(s, "&#10;", vbLf)
  s = Replace(s, "&quot" & ";", Chr$(34))
  s = Replace(s, "&lt" & ";", "<")
  s = Replace(s, "&gt" & ";", ">")
  ' ...
  
  ' Вернуть результат
  BoldToStrong = s

End Function
Изменено: ZVI - 13 Ноя 2017 14:19:36
Vladimir Zakharov
Microsoft MVP – Excel
FIND ругается, не находит значение, VBA
 
Одна из рекомендаций уже была - искать Find-ом с LookIn:=xlFormulas
Вот еще пара вариантов:
Код
Sub Test()
  'формула =ПОИСКПОЗ(3;17:17;0) или на англ =MATCH(3,17:17,0)
  Debug.Print 1, WorksheetFunction.Match(3, Rows(17), 0)
  Debug.Print 2, Evaluate("MATCH(" & 3 & "," & "17:17" & ",0)")
End Sub

Можно и в массив загнать значения диапазона, а затем в цикле пробежаться, это достаточно быстро, но диапазон желательно ограничить с промощью UsedRange, чтобы далеко не бегать, когда значения нет в диапазоне.
Изменено: ZVI - 4 Окт 2017 21:32:28
Vladimir Zakharov
Microsoft MVP – Excel
Как сделать ячейку, которая содержит формулу пустой?
 
Приложил один из вариантов
Vladimir Zakharov
Microsoft MVP – Excel
FIND ругается, не находит значение, VBA
 
Добрый вечер, Мотя! Просто на эти грабли я чаще наступал :)
Vladimir Zakharov
Microsoft MVP – Excel
FIND ругается, не находит значение, VBA
 
Find ищет значения (LookIn:=xlValues) только в ячейках, значения которых отображаются, а в данном случае ширина столбца T равна 0.25 стандартного символа и если снять объединение ячеек, то числа 3 в T17 не будет видно. Аналогичная ситуация возникает, когда большое число не вмещается в ячейку и в ячейке отображаются символы "#", или когда ячейка скрыта фильтром либо вручную.
При параметре LookIn:=xlFormulas у функция Find такого ограничения нет и Find "заглядывает" в формулы, но если нужно найти результат формулы ячейки, то LookIn:=xlFormulas не поможет, так как значения совпадают с формулами только у констант.
Изменено: ZVI - 4 Окт 2017 19:52:23
Vladimir Zakharov
Microsoft MVP – Excel
вирус в PLEX
 
Добрый день, Николай!
У меня другой антивирус, поэтому не могу проверить, но из моего опыта антивирусы обычно ругаются на код удаления макросов.
Этого можно избежать, если немного модифицировать код, чтобы антивирус его не смог явно идентифицировать.
Антивирус просто пытается избавить нас от опасных по его логике вещей, но робот же - что с него возьмешь!
Вот пример безопасной модификации кода (аналогично загадке про А и Б для робота):
Код
            ' --> На этот код обычно ругаются антивирусы
            'With VBObject.CodeModule
            '    .DeleteLines 1, .CountOfLines
            'End With
            ' <--
            
            ' --> А такой вариант обычно их устраивает
            With VBObject.CodeModule
              Dim i&
              i = .CountOfLines
              .DeleteLines 1, i
            End With
            ' <--

Если антивирусы считают опасным такой код: ActiveWorkbook.VBProject.vbcomponents.Remove VBObject , то можно попробовать, например, присвоить переменной объект ActiveWorkbook.VBProject.vbcomponents и к нему уже применить .Remove VBObject  - нужно поэкспериментировать.
Изменено: ZVI - 30 Сен 2017 08:25:26
Vladimir Zakharov
Microsoft MVP – Excel
Формула для маркировки месяца выполнения проекта
 
Добрый день. Ирина! Вот пара вариантов формулы ячейки F11 (копировать в остальные ячейки графика):
1) =ЕСЛИ(F$6>КОНМЕСЯЦА($U11;0);0;ЕСЛИ(F$6<=КОНМЕСЯЦА($T11;-1);0;1))
2) =(F$6<=КОНМЕСЯЦА($U11;0))*(F$6>КОНМЕСЯЦА($T11;-1))
Vladimir Zakharov
Microsoft MVP – Excel
Проблема с региональным разделителем разрядов
 
Вариант1 - см. приложенный пример Example1.xlsx
Вместо функции ТЕКСТ (англ - TEXT) примените необходимый формат непосредственно к ячейкам с числовыми значениями.
Тогда при любой локализации автоматически будут использоваться локальные разделители.

Вариант2 - см. приложенный пример Example2.xlsb
Можно использовать имя MyFormat с функцией копирования формата ячейки:
=ПОЛУЧИТЬ.ЯЧЕЙКУ(7;Sheet1!$F$2) или для англ  =GET.CELL(7,Sheet1!$F$2),
а в ячейке F2 (может быть любой другой ячейкой, в т.ч. и пустой) установить требуемый формат.
Тогда формула =ТЕКСТ(E3;MyFormat) или для английской версии =TEXT(E3,MyFormat) будет работать в любой локализации.
Но так как в имени MyFormat использована макрофункция ПОЛУЧИТЬ.ЯЧЕЙКУ(), то формат книги должен поддерживать макросы, а сами макросы нужно разрешать при загрузке книги.
Изменено: ZVI - 24 Сен 2017 04:52:39
Vladimir Zakharov
Microsoft MVP – Excel
Дивный глюк пересчета формул Microsoft Excel
 
Это давняя проблема не отображения на экране обновленного значения ячейки с формулой, которая  попала в скрытый при скроллировании столбец (объединенная ячейка или с форматом 'По центру выделения'). Но можете быть уверены в том, что формула  ячейки безусловно пересчитывается, несмотря на то, что  результат не обновляется на экране, в этом легко убедиться, если в видимой области (E29) написать формулу =C29.
Такая ситуация случается и без закрепления области листа.
Если меняете значение макросом, то просто добавьте в конце перерисовку экрана: Application.ScreenUpdating = True
Изменено: ZVI - 22 Сен 2017 14:55:14
Vladimir Zakharov
Microsoft MVP – Excel
Не увеличивается размерность массива ReDim Preserve
 
Цитата
Alemox написал: Значит на сайте майкрософта нас дурят
По крайней мере здесь и в VBA-справке написано, что ReDim относится к динамическому массиву: Remarks: The ReDimstatement is used to size or resize a dynamic array
А у Вас объявлен статический массив, который формируется в памяти по другим принципам, не подразумевающим изменение размерности.
Vladimir Zakharov
Microsoft MVP – Excel
Как вернуться на лист excel после ухода с него в другое приложение
 
Application.Visible = True
Vladimir Zakharov
Microsoft MVP – Excel
остановка макроса кнопкой ESC
 
Пробуйте так:
Код
Sub UserInterupting()

  On Error GoTo exit_
  
  ' Перехватывать Ctrl-Break или Esc
  Application.EnableCancelKey = xlErrorHandler
  
  ' Предупредить о начале длительного процесса
  MsgBox "Начало длительной обработки. Для приостановки нажимайте Ctrl-Break или ESC"
  
  ' Какой-нибудь длительный процесс
  Do
  Loop
  
exit_:
  
  If Err = 18 Then
    ' Работа макроса была приостановлена пользователем
    If MsgBox("Работа макроса приостановлена," & vbLf & "Продолжить?", vbYesNo) = vbYes Then
      ' Продолжить
      Resume
    Else
      ' Завершить
      MsgBox "Работа макроса завершена"
    End If
  End If
  
  Application.EnableCancelKey = xlInterrupt

End Sub
Изменено: ZVI - 30 Авг 2017 02:25:41
Vladimir Zakharov
Microsoft MVP – Excel
Обновление данных из web-запроса
 
Попробуйте после .Refresh добавить такие 2 строчки кода:
Application.CalculateUntilAsyncQueriesDone
Application.ScreenUpdating = True
Vladimir Zakharov
Microsoft MVP – Excel
Добавить текст в конце нижнего колонтитула в ворд файле
 
Удалите ссылку на Word и попробуйте такую версию кода:
Код
Sub InsertTextInFooterDown()

    Const wdScreen = 7
    
    Dim sFolder As String, sFiles As String
    Dim wdApp As Object 'New Word.Application
    Dim wdDoc As Object 'Word.Document
    Dim IsCreated As Boolean

    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err Then
      On Error GoTo 0
      Set wdApp = CreateObject("Word.Application")
      IsCreated = True
      wdApp.Visible = True
    End If

    sFolder = "C:\Temp\22\" 'задать свой путь к папке
    sFiles = Dir(sFolder & "*.docx") 'полный путь к word файлу
    
    Do While sFiles <> "" 'открваем все word файлы в папке sFolder
        Set wdDoc = wdApp.Documents.Open(sFolder & sFiles) 'открываем файл
        wdDoc.Sections(1).Footers(1).Range.Tables.Item(1).Cell(1, 1).Range.Select 'выделяем первую ячейку таблицы
        With wdApp.Selection
          .MoveDown Unit:=wdScreen, Count:=1 'идем в конец колонтитула
          'задаем необходимый формат
          .Font.Name = "Tahoma"
          .Font.Italic = wdToggle
          .Font.Size = 7
          .ParagraphFormat.Alignment = wdAlignParagraphRight
          .ParagraphFormat.SpaceBefore = 1
          .ParagraphFormat.SpaceBeforeAuto = False
          .ParagraphFormat.SpaceAfter = 3
          .ParagraphFormat.SpaceAfterAuto = False
          .TypeText Text:="Необходимый текст" 'вставляем необходимый текст
        End With
        wdDoc.Save  ' сохранить
        wdDoc.Close 'закрываем word файл
        sFiles = Dir
    Loop
    
    If IsCreated Then wdApp.Quit
    Set wdDoc = Nothing
    Set wdApp = Nothing

End Sub
Изменено: ZVI - 23 Авг 2017 12:17:24
Vladimir Zakharov
Microsoft MVP – Excel
Добавить текст в конце нижнего колонтитула в ворд файле
 
Цитата
ac1-caesar написал: смысла Const wdScreen = 7
Если в XLSM не установлена или битая ссылка на Microsoft 16.0 Object Library,  то внутри Excel нет такой константы, т.к. она определена не в Excel, а в приложении Word. Чтобы не зависеть от ссылки на Word можно либо задать в коде Excel константу как предложено (по сути, продублировать Word-овскую), либо в коде сразу записать числовое значение константы: Unit:=7
Изменено: ZVI - 23 Авг 2017 12:19:54
Vladimir Zakharov
Microsoft MVP – Excel
Добавить текст в конце нижнего колонтитула в ворд файле
 
Код не тестировал, но ещё, как минимум, нужно в начале кода задать константу приложения word, которую Excel не знает: Const wdScreen = 7
Посмотрел - в references указана ссылка на Word 2016,  её лучше убрать, так как при открытии в предыдущих версиях эта ссылка станет битой (MISSING)
Изменено: ZVI - 23 Авг 2017 11:32:09
Vladimir Zakharov
Microsoft MVP – Excel
Экспорт из Excel 2007 в Word 2007
 
Добрый день. Вместо objWord.Selection.Paste запишите objWord.Selection.PasteAndFormat 16
Vladimir Zakharov
Microsoft MVP – Excel
Печать pdf файлов по гиперссылке макросом, печать без открытия файлов
 
Цитата
PerfectVam:  ПечатьPDF.xlsm  
Если установлена профессиональная версия Acrobat, и такой тест не вызывает ошибки:
Код
Sub Test()
  With CreateObject("AcroExch.App"): End With
  With CreateObject("AcroExch.AVDoc"): End With
End Sub

или, что в принципе одно и тоже, установлена ссылка: VBE - Tools - Refereces - 'Acrobat' или 'Adobe Acrobat ##.# Type Library'  (XX.X - номер версии) - OK,
то распечатать файлы PDF или их заданные страницы можно, используя метод AVDoc.PrintPagesSilent.
У меня, например, в XP устанавливалась такая ссылка (reference) на библиотеку Acrobat XI Professional: "C:\Program Files\Adobe\Acrobat 11.0\Acrobat\acrobat.tlb"
Принцип распечатки:
Код
Sub PrintPDF()
  Const f = "C:\Temp\Test.PDF"
  With CreateObject("AcroExch.App")
    With CreateObject("AcroExch.AVDoc")
      .Open f, vbNullString
      .PrintPagesSilent 0, .GetPDDoc.GetNumPages - 1, 0, False, True
    End With
    .CloseAllDocs
    .Exit
  End With
End Sub

Приведенный выше код распечатает документ PDF аналогично тому, как это может быть сделано из интерфейса Adobe. А проблема спуллинга и очередности распечатки на сетевом принтере - это действительно отдельная задача.
Изменено: ZVI - 22 Авг 2017 22:22:17
Vladimir Zakharov
Microsoft MVP – Excel
В теле письма: Текст + Гиперссылка + Текст, с помощью ВБА
 
В HTML символы CHR(10)  и CHR(13) игнорируются и используется только для удобства форматирования.
Вместо CHR(10) используйте тэг  "<br>":
Email_Body = "Привет!" & "<br><br>" & "..."
Изменено: ZVI - 21 Авг 2017 07:35:56
Vladimir Zakharov
Microsoft MVP – Excel
Проблема со снятием выделения в Excel после копирования
 
К сожалению, это проявление новой и странной с моей точки зрения функциональности новых версий Excel. Не отключается никак. Вроде как упрощает множественное копирование. Теперь режим копирования прерывается либо по Esc, либо если завершать копирование по Enter.
Затронуло это и VBA - после Paste теперь обязательно нужно добавлять Application.CutCopyMode = False,  хотя это обещают исправить.
Лучше бы по умолчанию все было, как привыкли за десятилетия, а для тех, кому нужно, добавить флажок в настройки.
Изменено: ZVI - 19 Авг 2017 09:51:45
Vladimir Zakharov
Microsoft MVP – Excel
Сумма прописью (MCH) для любого разделителя целых и десятичных разрядов
 
Правильное название темы:
Сумма прописью (MCH) для любого разделителя целых и десятичных разрядов
Изменено: ZVI - 16 Авг 2017 04:16:34
Vladimir Zakharov
Microsoft MVP – Excel
Заполнение и сохранение текущей даты при заполнении строк таблицы
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim a()
  Dim i As Long, r As Long, c As Long
  Dim Rng As Range
  Set Rng = Intersect(Target, Me.UsedRange.EntireRow.Range("A:P"))
  If Rng Is Nothing Then Exit Sub
  Set Rng = Intersect(Rng.EntireRow, Me.Range("A:P"))
  a() = Rng.Value
  For r = 1 To UBound(a)
    i = 0
    For c = 2 To UBound(a, 2)
      If Len(Trim(a(r, c))) > 0 Then
        i = 1
        If Len(Trim(a(r, 1))) = 0 Then a(r, 1) = Date
        Exit For
      End If
    Next
    If i = 0 Then a(r, 1) = Empty
  Next
exit_:
  Application.EnableEvents = False
  Rng.Columns(1).Value = a()
  Application.EnableEvents = True
End Sub
Изменено: ZVI - 16 Авг 2017 01:22:04
Vladimir Zakharov
Microsoft MVP – Excel
Как скопировать в буфер обмена текст из ячейки с чисткой текста от лишних символов?
 
Дополню, что вместо Const RNG = "Таблица13[Столбец4]"
можно написать, например Const RNG = "G8:G9"
А если нужно значения ячеек, выделенных пользователем, то строка с Const RNG не нужна, а вместо a = Range(RNG).Value нужно записать a = Selection.Value
Непонятно только зачем вообще буфер обмена использовать, если это не конечная задача, напишите тогда поконкретнее.
Изменено: ZVI - 15 Авг 2017 22:40:30
Vladimir Zakharov
Microsoft MVP – Excel
Как скопировать в буфер обмена текст из диапазона с чисткой текста от лишних символов?
 
Цитата
vikttur написал: Ответ ZVI перенесен в первую тему
Виктор, спасибо! Удалите тогда эту тему, пожалуйста, отвечу там. Насколько я понял, эта тема появилась из-за того, что в предыдущей автор темы преждевременно посчитал, что все ясно и тема закрыта.
Vladimir Zakharov
Microsoft MVP – Excel
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 126 След.