Преобразование к русским кавычкам (из "..." в « ...»)(c) Максименко Юрий: http://db-maker.narod.ru Function russianQuoting(ByVal strForQuote As String) As String '(c) Максименко Юрий http://db-maker.narod.ru 'На клавиатуре нет русских кавычек, аксессовский хелп ничего умнее копирования из таблицы Символов не предлагает. 'Это исключает возможность авитозаполнения в комбобоксах, усложняет ввод названий. 'Нижеприведённая простая функция решает эту проблему. То есть Вы можете вводить названия с обычными кавычками, 'а в отчётах Вы можете использовать поле =russianQuoting([ПолеНазвания]) '-------------------------------------------------------------------- strForQuote = Trim(strForQuote) 'Заменим кавычку-начало слова If (Left(strForQuote, 1)) = Chr(34) Then strForQuote = Chr(171) & Mid(strForQuote, 2) 'заменим кавычку-конец слова If (Right(strForQuote, 1)) = Chr(34) Then strForQuote = Mid(strForQuote, 1, Len(strForQuote) - 1) & Chr(187) 'заменим кавычку с пробелом перед ней strForQuote = strReplace(strForQuote, " " & Chr(34), " " & Chr(171)) 'заменим кавычку с пробелом после неё strForQuote = strReplace(strForQuote, Chr(34) & " ", Chr(187) & " ") russianQuoting = strForQuote End Function Function strReplace(ByVal strSubject As String, ByVal forSearsh As String, ByVal forReplace As String) As String 'Дублирует Replace(): эта функция работает как-то странно и в запросах бастует 'Возвращает строку, в которой в исходной строке strSubject подстрока forSearsh заменена на подстроку forReplace '-------------------------------------------------------------------- Dim p, l As Integer p = InStr(strSubject, forSearsh) l = Len(forSearsh) Do Until p = 0 strSubject = Left(strSubject, p - 1) & forReplace & Mid(strSubject, p + l) p = InStr(strSubject, forSearsh) Loop strReplace = strSubject End Function |
|||
L.E. 05.06.2016 |