Да... Корявенько получается. Не думал, что там всё так запутано... А почему цифры то синие, то красные? Да и с распознаванием стрингов по кавычкам и "обсериванию" ( ) текста внутри них - тоже как-то глючно: то серит, то не серит, то кавычки захватит, то нет... А для того, чтобы удобно было юзать (когда всё отладится), нужно будет на панели ввода ответа сделать отдельные кнопки обрамления тэгами: "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] необходим для парсинга. Работает как идентификатор.
Цитата (Alex_ST писал(а)):
Вопрос к тому, что все ранее выложенные на форуме коды оформлены простыми тэгами {code}...{/code} и, естественно, новая фича на них никак не повлияла.
Тут соглашусь с Сергеем, лучше формулы и код разделить. Хотя, можно попытаться обработать формулы, при условии, что они не содержат перевода строк (т.к. код парсится построчно). При таком подходе будут выделены строки и числовые литералы.
Цитата (Alex_ST писал(а)):
К стати, а какой там внутри шрифт теперь?
Courier New
Цитата (Alex_ST писал(а)):
А почему цифры то синие, то красные?
Потому, что парсинг такого рода задача нетривиальная) Я допустил ошибку [и не одну] в реге. Если будет время, исправлю, плюс постараюсь увеличить скорость обработки.
Цитата (Alex_ST писал(а)):
распознаванием стрингов по кавычкам и "обсериванию"
Алекс, ты мне всегда нравился за то, что умел подбирать слова))) Такая ерунда из-за переводов строк. Повторюсь, парсинг производится построчно.
Цитата (Alex_ST писал(а)):
Только не понятно, почему код обрамляется в двойные тэги {vba}{code}...{/code}{/vba}
На то есть причина: тег [code]...[\code] обрабатывается Ucoz'ом как содержащий код. Если его не будет, то все отступы в начале строк будут съедены. Стоит отметить, что Ucoz довольно странно расставляет отступы. Если в оригинале 4-е пробела, то укоз скорее всего покажет 5, 6 или хз знает сколько) Пришлось за ним подчищать. [vba]...[/vba] необходим для парсинга. Работает как идентификатор.
Цитата (Alex_ST писал(а)):
Вопрос к тому, что все ранее выложенные на форуме коды оформлены простыми тэгами {code}...{/code} и, естественно, новая фича на них никак не повлияла.
Тут соглашусь с Сергеем, лучше формулы и код разделить. Хотя, можно попытаться обработать формулы, при условии, что они не содержат перевода строк (т.к. код парсится построчно). При таком подходе будут выделены строки и числовые литералы.
Цитата (Alex_ST писал(а)):
К стати, а какой там внутри шрифт теперь?
Courier New
Цитата (Alex_ST писал(а)):
А почему цифры то синие, то красные?
Потому, что парсинг такого рода задача нетривиальная) Я допустил ошибку [и не одну] в реге. Если будет время, исправлю, плюс постараюсь увеличить скорость обработки.
Цитата (Alex_ST писал(а)):
распознаванием стрингов по кавычкам и "обсериванию"
Алекс, ты мне всегда нравился за то, что умел подбирать слова))) Такая ерунда из-за переводов строк. Повторюсь, парсинг производится построчно.nerv
Чебурашка стал символом олимпийских игр. А чего достиг ты? Тишина - самый громкий звук
Да... При длинных комментариях в коде получается не очень: экран расширяется
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 AsBoolean 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" OnErrorResumeNext
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:="Сохранение копии файла") 'задать путь сохранения и имя копии файла в окне выбора IfVarType(FileName) = vbBoolean ThenExitSub' если нажали "Отмена", то 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 ' восстановить параметры исходного файла EndWith EndSub
Да... При длинных комментариях в коде получается не очень: экран расширяется
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 AsBoolean 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" OnErrorResumeNext
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:="Сохранение копии файла") 'задать путь сохранения и имя копии файла в окне выбора IfVarType(FileName) = vbBoolean ThenExitSub' если нажали "Отмена", то 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 ' восстановить параметры исходного файла EndWith EndSub
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 AsBoolean 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" OnErrorResumeNext
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:="Сохранение копии файла") 'задать путь сохранения и имя копии файла в окне выбора IfVarType(FileName) = vbBoolean ThenExitSub' если нажали "Отмена", то 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 ' восстановить параметры исходного файла EndWith EndSub
Закомментил
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 AsBoolean 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" OnErrorResumeNext
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:="Сохранение копии файла") 'задать путь сохранения и имя копии файла в окне выбора IfVarType(FileName) = vbBoolean ThenExitSub' если нажали "Отмена", то 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 ' восстановить параметры исходного файла EndWith EndSub
У меня и на работе на Эксплорере и дома на хроме код ничем от простого текста не отличается. Точно поломали - ведь раньше очень хорошо было - на сереньком фоне...
вот где текст, а где код?
У меня и на работе на Эксплорере и дома на хроме код ничем от простого текста не отличается. Точно поломали - ведь раньше очень хорошо было - на сереньком фоне...
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
) текста внутри них - тоже как-то глючно: то серит, то не серит, то кавычки захватит, то нет... 
