Да... Корявенько получается. Не думал, что там всё так запутано... А почему цифры то синие, то красные? Да и с распознаванием стрингов по кавычкам и "обсериванию" ( ) текста внутри них - тоже как-то глючно: то серит, то не серит, то кавычки захватит, то нет... А для того, чтобы удобно было юзать (когда всё отладится), нужно будет на панели ввода ответа сделать отдельные кнопки обрамления тэгами: "Monotype" ( {code}...{/code} ), "VBA code" ( {vba}{code}...{/code}{/vba} ), "Formula" ( {frm}{code}...{/code}{/frm} )
Да... Корявенько получается. Не думал, что там всё так запутано... А почему цифры то синие, то красные? Да и с распознаванием стрингов по кавычкам и "обсериванию" ( ) текста внутри них - тоже как-то глючно: то серит, то не серит, то кавычки захватит, то нет... А для того, чтобы удобно было юзать (когда всё отладится), нужно будет на панели ввода ответа сделать отдельные кнопки обрамления тэгами: "Monotype" ( {code}...{/code} ), "VBA code" ( {vba}{code}...{/code}{/vba} ), "Formula" ( {frm}{code}...{/code}{/frm} )Alex_ST
Только не понятно, почему код обрамляется в двойные тэги {vba}{code}...{/code}{/vba}
На то есть причина: тег [code]...[\code] обрабатывается Ucoz'ом как содержащий код. Если его не будет, то все отступы в начале строк будут съедены. Стоит отметить, что Ucoz довольно странно расставляет отступы. Если в оригинале 4-е пробела, то укоз скорее всего покажет 5, 6 или хз знает сколько) Пришлось за ним подчищать. [vba]...[/vba] необходим для парсинга. Работает как идентификатор.
Quote (Alex_ST)
Вопрос к тому, что все ранее выложенные на форуме коды оформлены простыми тэгами {code}...{/code} и, естественно, новая фича на них никак не повлияла.
Тут соглашусь с Сергеем, лучше формулы и код разделить. Хотя, можно попытаться обработать формулы, при условии, что они не содержат перевода строк (т.к. код парсится построчно). При таком подходе будут выделены строки и числовые литералы.
Quote (Alex_ST)
К стати, а какой там внутри шрифт теперь?
Courier New
Quote (Alex_ST)
А почему цифры то синие, то красные?
Потому, что парсинг такого рода задача нетривиальная) Я допустил ошибку [и не одну] в реге. Если будет время, исправлю, плюс постараюсь увеличить скорость обработки.
Quote (Alex_ST)
распознаванием стрингов по кавычкам и "обсериванию"
Алекс, ты мне всегда нравился за то, что умел подбирать слова))) Такая ерунда из-за переводов строк. Повторюсь, парсинг производится построчно.
Quote (Alex_ST)
Только не понятно, почему код обрамляется в двойные тэги {vba}{code}...{/code}{/vba}
На то есть причина: тег [code]...[\code] обрабатывается Ucoz'ом как содержащий код. Если его не будет, то все отступы в начале строк будут съедены. Стоит отметить, что Ucoz довольно странно расставляет отступы. Если в оригинале 4-е пробела, то укоз скорее всего покажет 5, 6 или хз знает сколько) Пришлось за ним подчищать. [vba]...[/vba] необходим для парсинга. Работает как идентификатор.
Quote (Alex_ST)
Вопрос к тому, что все ранее выложенные на форуме коды оформлены простыми тэгами {code}...{/code} и, естественно, новая фича на них никак не повлияла.
Тут соглашусь с Сергеем, лучше формулы и код разделить. Хотя, можно попытаться обработать формулы, при условии, что они не содержат перевода строк (т.к. код парсится построчно). При таком подходе будут выделены строки и числовые литералы.
Quote (Alex_ST)
К стати, а какой там внутри шрифт теперь?
Courier New
Quote (Alex_ST)
А почему цифры то синие, то красные?
Потому, что парсинг такого рода задача нетривиальная) Я допустил ошибку [и не одну] в реге. Если будет время, исправлю, плюс постараюсь увеличить скорость обработки.
Quote (Alex_ST)
распознаванием стрингов по кавычкам и "обсериванию"
Алекс, ты мне всегда нравился за то, что умел подбирать слова))) Такая ерунда из-за переводов строк. Повторюсь, парсинг производится построчно.nerv
Чебурашка стал символом олимпийских игр. А чего достиг ты? Тишина - самый громкий звук
Да... При длинных комментариях в коде получается не очень: экран расширяется [vba]
Code
Sub Save_Copy_As() '--------------------------------------------------------------------------------------- ' Procedure : Save_Copy_As ' Author : Alex_ST ' DateTime : 07.02.2012, 17:05 ' URL : http://www.excelworld.ru/forum/3-1293-14737-16-1328619875 ' Purpose : Сохранение копии активного файла ' Notes : Путь сохранения копий хранится в коллекции .Names книги (в именованном диапазоне) '--------------------------------------------------------------------------------------- Const sPath_in_Names = "Path4SaveCopyAs" ' имя элемента коллекции .Names, в котором должен храниться путь для сохранения копий файла Dim sSuff$: sSuff = " [" & Format(Now, "yyyy/mm/dd hh-mm'ss''") & "]" ' суффикс к имени файла копии - дата и время сохренения копии файла Dim FileName, sExp$, sDirPath$, sFullFilePath$, sNewPath$ Dim bReadOnlyRecommended As Boolean With ActiveWorkbook FileName = .Name ' например, "Книга1.xls" sExp = Right(FileName, Len(FileName) - InStrRev(FileName, ".") + 1) ' расширение файла вместе с точкой (например, ".xls") FileName = Left(FileName, Len(FileName) - Len(sExp)) & sSuff & sExp ' например, "Книга1 [2012.02.06 15-24'39''].xls" On Error Resume Next sDirPath = .Names(sPath_in_Names).Value ' считать из коллекции .Names значение, ранее сохраненное под именем sPath_in_Names If Err Then .Names.Add sPath_in_Names, .Path & "\": sDirPath = .Names(sPath_in_Names).Value ' если считать не удалось, значит путь ранее не задавался и он для первого раза задаётся равным ActiveWorkbook.Path sDirPath = Mid(sDirPath, 3, Len(sDirPath) - 3) ' убрать из считанного значения в начале "= и в конце " sDirPath = sDirPath & IIf(Right(sDirPath, 1) = "\", "", "\") ' на всякий случай (если имя было задано в ручную и при этом не верно - без слэша) .Names(sPath_in_Names).Value = sDirPath ' запомнить путь сохранения копий в коллекции .Names под именем sPath_in_Names sFullFilePath = sDirPath & FileName ' полный путь сохранения вместе с полным именем копии REPEAT_: FileName = Application.GetSaveAsFilename(InitialFileName:=sFullFilePath, _ FileFilter:="Excel Files (*" & sExp & "), *" & sExp & ", All Files (*.*),*.*", _ Title:="Сохранение копии файла") 'задать путь сохранения и имя копии файла в окне выбора If VarType(FileName) = vbBoolean Then Exit Sub ' если нажали "Отмена", то FileName = False, если "Сохранить" - полный путь к файлу вместе с его именем If FileName = .FullName Then MsgBox "Здесь нельзя сохранить файл под таким именем!", 16, "Ошибка": GoTo REPEAT_ sDirPath = Left(FileName, InStrRev(FileName, "\")) ' путь к папке сохранения копий без имени файла .Names(sPath_in_Names).Value = sDirPath ' запомнить выбранный в диалоге путь в коллекции .Names под именем sPath_in_Names bReadOnlyRecommended = .ReadOnlyRecommended ' запомнить параметры исходного файла .ReadOnlyRecommended = --(MsgBox("Рекомендовать открывать файл только для чтения?", 36) - 7) ' MsgBox Argument 4==vbYesNo 32==vbQuestion, MsgBox Return Values: vbYes=6, vbNo=7 .SaveCopyAs FileName .ReadOnlyRecommended = bReadOnlyRecommended ' восстановить параметры исходного файла End With End Sub
[/vba]
Да... При длинных комментариях в коде получается не очень: экран расширяется [vba]
Code
Sub Save_Copy_As() '--------------------------------------------------------------------------------------- ' Procedure : Save_Copy_As ' Author : Alex_ST ' DateTime : 07.02.2012, 17:05 ' URL : http://www.excelworld.ru/forum/3-1293-14737-16-1328619875 ' Purpose : Сохранение копии активного файла ' Notes : Путь сохранения копий хранится в коллекции .Names книги (в именованном диапазоне) '--------------------------------------------------------------------------------------- Const sPath_in_Names = "Path4SaveCopyAs" ' имя элемента коллекции .Names, в котором должен храниться путь для сохранения копий файла Dim sSuff$: sSuff = " [" & Format(Now, "yyyy/mm/dd hh-mm'ss''") & "]" ' суффикс к имени файла копии - дата и время сохренения копии файла Dim FileName, sExp$, sDirPath$, sFullFilePath$, sNewPath$ Dim bReadOnlyRecommended As Boolean With ActiveWorkbook FileName = .Name ' например, "Книга1.xls" sExp = Right(FileName, Len(FileName) - InStrRev(FileName, ".") + 1) ' расширение файла вместе с точкой (например, ".xls") FileName = Left(FileName, Len(FileName) - Len(sExp)) & sSuff & sExp ' например, "Книга1 [2012.02.06 15-24'39''].xls" On Error Resume Next sDirPath = .Names(sPath_in_Names).Value ' считать из коллекции .Names значение, ранее сохраненное под именем sPath_in_Names If Err Then .Names.Add sPath_in_Names, .Path & "\": sDirPath = .Names(sPath_in_Names).Value ' если считать не удалось, значит путь ранее не задавался и он для первого раза задаётся равным ActiveWorkbook.Path sDirPath = Mid(sDirPath, 3, Len(sDirPath) - 3) ' убрать из считанного значения в начале "= и в конце " sDirPath = sDirPath & IIf(Right(sDirPath, 1) = "\", "", "\") ' на всякий случай (если имя было задано в ручную и при этом не верно - без слэша) .Names(sPath_in_Names).Value = sDirPath ' запомнить путь сохранения копий в коллекции .Names под именем sPath_in_Names sFullFilePath = sDirPath & FileName ' полный путь сохранения вместе с полным именем копии REPEAT_: FileName = Application.GetSaveAsFilename(InitialFileName:=sFullFilePath, _ FileFilter:="Excel Files (*" & sExp & "), *" & sExp & ", All Files (*.*),*.*", _ Title:="Сохранение копии файла") 'задать путь сохранения и имя копии файла в окне выбора If VarType(FileName) = vbBoolean Then Exit Sub ' если нажали "Отмена", то FileName = False, если "Сохранить" - полный путь к файлу вместе с его именем If FileName = .FullName Then MsgBox "Здесь нельзя сохранить файл под таким именем!", 16, "Ошибка": GoTo REPEAT_ sDirPath = Left(FileName, InStrRev(FileName, "\")) ' путь к папке сохранения копий без имени файла .Names(sPath_in_Names).Value = sDirPath ' запомнить выбранный в диалоге путь в коллекции .Names под именем sPath_in_Names bReadOnlyRecommended = .ReadOnlyRecommended ' запомнить параметры исходного файла .ReadOnlyRecommended = --(MsgBox("Рекомендовать открывать файл только для чтения?", 36) - 7) ' MsgBox Argument 4==vbYesNo 32==vbQuestion, MsgBox Return Values: vbYes=6, vbNo=7 .SaveCopyAs FileName .ReadOnlyRecommended = bReadOnlyRecommended ' восстановить параметры исходного файла End With End Sub
Sub Save_Copy_As() '--------------------------------------------------------------------------------------- ' Procedure : Save_Copy_As ' Author : Alex_ST ' DateTime : 07.02.2012, 17:05 ' URL : http://www.excelworld.ru/forum/3-1293-14737-16-1328619875 ' Purpose : Сохранение копии активного файла ' Notes : Путь сохранения копий хранится в коллекции .Names книги (в именованном диапазоне) '--------------------------------------------------------------------------------------- Const sPath_in_Names = "Path4SaveCopyAs" ' имя элемента коллекции .Names, в котором должен храниться путь для сохранения копий файла Dim sSuff$: sSuff = " [" & Format(Now, "yyyy/mm/dd hh-mm'ss''") & "]" ' суффикс к имени файла копии - дата и время сохренения копии файла Dim FileName, sExp$, sDirPath$, sFullFilePath$, sNewPath$ Dim bReadOnlyRecommended As Boolean With ActiveWorkbook FileName = .Name ' например, "Книга1.xls" sExp = Right(FileName, Len(FileName) - InStrRev(FileName, ".") + 1) ' расширение файла вместе с точкой (например, ".xls") FileName = Left(FileName, Len(FileName) - Len(sExp)) & sSuff & sExp ' например, "Книга1 [2012.02.06 15-24'39''].xls" On Error Resume Next sDirPath = .Names(sPath_in_Names).Value ' считать из коллекции .Names значение, ранее сохраненное под именем sPath_in_Names If Err Then .Names.Add sPath_in_Names, .Path & "\": sDirPath = .Names(sPath_in_Names).Value ' если считать не удалось, значит путь ранее не задавался и он для первого раза задаётся равным ActiveWorkbook.Path sDirPath = Mid(sDirPath, 3, Len(sDirPath) - 3) ' убрать из считанного значения в начале "= и в конце " sDirPath = sDirPath & IIf(Right(sDirPath, 1) = "\", "", "\") ' на всякий случай (если имя было задано в ручную и при этом не верно - без слэша) .Names(sPath_in_Names).Value = sDirPath ' запомнить путь сохранения копий в коллекции .Names под именем sPath_in_Names sFullFilePath = sDirPath & FileName ' полный путь сохранения вместе с полным именем копии REPEAT_: FileName = Application.GetSaveAsFilename(InitialFileName:=sFullFilePath, _ FileFilter:="Excel Files (*" & sExp & "), *" & sExp & ", All Files (*.*),*.*", _ Title:="Сохранение копии файла") 'задать путь сохранения и имя копии файла в окне выбора If VarType(FileName) = vbBoolean Then Exit Sub ' если нажали "Отмена", то FileName = False, если "Сохранить" - полный путь к файлу вместе с его именем If FileName = .FullName Then MsgBox "Здесь нельзя сохранить файл под таким именем!", 16, "Ошибка": GoTo REPEAT_ sDirPath = Left(FileName, InStrRev(FileName, "\")) ' путь к папке сохранения копий без имени файла .Names(sPath_in_Names).Value = sDirPath ' запомнить выбранный в диалоге путь в коллекции .Names под именем sPath_in_Names bReadOnlyRecommended = .ReadOnlyRecommended ' запомнить параметры исходного файла .ReadOnlyRecommended = --(MsgBox("Рекомендовать открывать файл только для чтения?", 36) - 7) ' MsgBox Argument 4==vbYesNo 32==vbQuestion, MsgBox Return Values: vbYes=6, vbNo=7 .SaveCopyAs FileName .ReadOnlyRecommended = bReadOnlyRecommended ' восстановить параметры исходного файла End With End Sub
[/vba]
Закомментил
[vba]
Code
Sub Save_Copy_As() '--------------------------------------------------------------------------------------- ' Procedure : Save_Copy_As ' Author : Alex_ST ' DateTime : 07.02.2012, 17:05 ' URL : http://www.excelworld.ru/forum/3-1293-14737-16-1328619875 ' Purpose : Сохранение копии активного файла ' Notes : Путь сохранения копий хранится в коллекции .Names книги (в именованном диапазоне) '--------------------------------------------------------------------------------------- Const sPath_in_Names = "Path4SaveCopyAs" ' имя элемента коллекции .Names, в котором должен храниться путь для сохранения копий файла Dim sSuff$: sSuff = " [" & Format(Now, "yyyy/mm/dd hh-mm'ss''") & "]" ' суффикс к имени файла копии - дата и время сохренения копии файла Dim FileName, sExp$, sDirPath$, sFullFilePath$, sNewPath$ Dim bReadOnlyRecommended As Boolean With ActiveWorkbook FileName = .Name ' например, "Книга1.xls" sExp = Right(FileName, Len(FileName) - InStrRev(FileName, ".") + 1) ' расширение файла вместе с точкой (например, ".xls") FileName = Left(FileName, Len(FileName) - Len(sExp)) & sSuff & sExp ' например, "Книга1 [2012.02.06 15-24'39''].xls" On Error Resume Next sDirPath = .Names(sPath_in_Names).Value ' считать из коллекции .Names значение, ранее сохраненное под именем sPath_in_Names If Err Then .Names.Add sPath_in_Names, .Path & "\": sDirPath = .Names(sPath_in_Names).Value ' если считать не удалось, значит путь ранее не задавался и он для первого раза задаётся равным ActiveWorkbook.Path sDirPath = Mid(sDirPath, 3, Len(sDirPath) - 3) ' убрать из считанного значения в начале "= и в конце " sDirPath = sDirPath & IIf(Right(sDirPath, 1) = "\", "", "\") ' на всякий случай (если имя было задано в ручную и при этом не верно - без слэша) .Names(sPath_in_Names).Value = sDirPath ' запомнить путь сохранения копий в коллекции .Names под именем sPath_in_Names sFullFilePath = sDirPath & FileName ' полный путь сохранения вместе с полным именем копии REPEAT_: FileName = Application.GetSaveAsFilename(InitialFileName:=sFullFilePath, _ FileFilter:="Excel Files (*" & sExp & "), *" & sExp & ", All Files (*.*),*.*", _ Title:="Сохранение копии файла") 'задать путь сохранения и имя копии файла в окне выбора If VarType(FileName) = vbBoolean Then Exit Sub ' если нажали "Отмена", то FileName = False, если "Сохранить" - полный путь к файлу вместе с его именем If FileName = .FullName Then MsgBox "Здесь нельзя сохранить файл под таким именем!", 16, "Ошибка": GoTo REPEAT_ sDirPath = Left(FileName, InStrRev(FileName, "\")) ' путь к папке сохранения копий без имени файла .Names(sPath_in_Names).Value = sDirPath ' запомнить выбранный в диалоге путь в коллекции .Names под именем sPath_in_Names bReadOnlyRecommended = .ReadOnlyRecommended ' запомнить параметры исходного файла .ReadOnlyRecommended = --(MsgBox("Рекомендовать открывать файл только для чтения?", 36) - 7) ' MsgBox Argument 4==vbYesNo 32==vbQuestion, MsgBox Return Values: vbYes=6, vbNo=7 .SaveCopyAs FileName .ReadOnlyRecommended = bReadOnlyRecommended ' восстановить параметры исходного файла End With End Sub
У меня и на работе на Эксплорере и дома на хроме код ничем от простого текста не отличается. Точно поломали - ведь раньше очень хорошо было - на сереньком фоне... [vba]
Code
вот где текст, а где код?
[/vba]
У меня и на работе на Эксплорере и дома на хроме код ничем от простого текста не отличается. Точно поломали - ведь раньше очень хорошо было - на сереньком фоне... [vba]
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
) текста внутри них - тоже как-то глючно: то серит, то не серит, то кавычки захватит, то нет... 
