Преобразование к русским кавычкам (из "..." в « ...»)

(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