'Begin Description ' Данный скрипт создаёт XML-файл для Triple-S версии 1.2 и соответствующий ' файл данных на основе текущего файла данных SPSS, запрашивая при этом у пользователя папку, ' куда следует сохранить эти файлы. Имя файла XML по умолчанию: <имя_файла_данных_spss>_SSS.XML ' Файл данных экспортируется с тем же префиксом, что и для XML-файла, но с расширением.DAT. ' Создаётся также файл со схемой данных (<префикс_XML>.LST), содержимое которого выводится в окно результатов SPSS Output. ' ' Пользователь также имеет альтернативу вызова данного скрипта из синтаксиса с параметром, в ' котором он указывает путь для сохранения XML-файла, например: ' SCRIPT 'Export2Triple-S.sbs' ("C:\\My Documents\\output.xml"). 'End Description ' ПОДРОБНАЯ СПЕЦИФИКАЦИЯ ' Создавая файлы, скрипт не проверяет существование файлов с теми же именами, а просто ' перезаписывает их. ' ' Программа экспортирует все переменные SPSS типа Numeric как ' переменные типов Single или Quantity Triple-S. ' Все прочие типы переменных экспортируются как символьные переменные Triple-S ' (включая переменные типов Comma,Dot,N и научного формата, которые могут содержать ' допустимые числовые данные), так как такие форматы не поддерживаются в качестве допустимых ' количественных (Quantity) форматов в Triple-S. ' При желании пользователь может перед экспортом поменять формат таких типов на Numeric ' (F-формат), если требуется, чтобы при экспорте данные переменные обрабатывались как несимвольные. ' Последний столбец в схеме данных обозначает исходный формат для нестроковых переменных, ' которые при экспорте стали символьными. ' ' Тип Numeric экспортируется в тип Single, если: ' Правило 1) Print-формат для этой переменной не допускает десятичных знаков (т.е. целочисленный формат), ' Правило 2) кроме того, переменная имеет описанные метки значений, ' Правило 3) кроме того, переменная принимает только положительные или нулевые значения, которые описаны среди меток значений. ' Все прочие переменные типа Numeric экспортируются в тип Quantity Triple-S. ' ' Так как нулевые значения в определении типа Triple-S Single не допускаются, переменные с нулевыми ' значениями всё ещё могут экспортироваться в тип Single, но нулевые значения экспортируются как комментарии, ' о чём в журнальном файле будет сделана пометка "zero-value" в последней колонке против такой переменной. ' Если переменная с потенциальным типом Single имеет лишь одну метку значения, которая ассоциирована с 0, такая ' переменная будет экспортирована в тип Quantity. ' ' Если среди меток значений переменной Numeric есть такие, которые используют один или несколько знаков после запятой, ' переменная экспортируется в тип Quantity, но в последней колонке схемы данных против такой переменной ' появляется пометка "labelled". Triple-S позволяет экспорт переменных Quantity с метками ' их значений. Таким образом, если пользователь желает экспортировать переменные в тип Single, он ' должен убедиться, что их Print-формат не имеет дробных знаков, а все возможные положительные значения ' имеют соответствующие метки. ' ' Если на момент экспорта в SPSS включено взвешивание, весовая переменная будет соответственно ' обозначена при экспорте в Triple-S. Это единственная новая опция версии 1.2 Triple-S, которая учтена ' в экспортирующем скрипте. Для отключения этой опции и экспорта в версию 1.1, измените значение константы ' Tripe_SVersion ниже на 1.1. ' Triple-S требует, чтобы весовая переменная была экспортирована как quantities, так что если весовая ' переменная по прочим признакам идентифицируется как Single, она всё же будет экспортирована как помеченная ' (labelled) Quantity-переменная. Это примечание, опять же, будет содержаться в схеме данных, в последнем столбце. ' ' Поскольку назначение создаваемых файлов - экспорт в другую программу, инструкция ' DOCTYPE в XML-файле выводится закомментированной. ' ' За более подробной информацией о стандарте обмена данными обследований Triple-S и прочих ' стандартах обращайтесь к веб-сайту Triple-S: www.triple-s.org ' ' Тема : Экспорт в Triple-S ' Версия : 1.1 ' Автор : Chris Johnson ' Компания : Merlinco Ltd, Лондон, Великобритания ' Веб-сайт : www.merlinco.co.uk ' Дата : 22 октября 2002 года ' Протестировано в: SPSS 11.0 ' Обновления после версии 1.0 (3 октября 2002) ' ' Версия 1.1 ' ' 1) добавлен код для поддержки отрицательных и нулевых меток значений (Value Labels). 'Перевод: А. Балабанов, 17.01.2009. 'Проверено: SPSS 15.0. 'Размещение: http://www.spsstools.ru/Scripts/ImportExport/Export2Triple-S.txt (.sbs). Sub Main() 'On Error GoTo EndOfSub 'Следующие 2 строки комментируются при использовании скрипта в SPSS .sbs-файле (они нужны для разработки в Visual Studio) 'Dim objSpssApp As spsswin.Application 'Set objSpssApp = GetObject(, "SPSS.Application") 'Объявление переменных Const Triple_SVersion As Double =1.2 ' Исправьте с 1.2 на 1.1 для совместимости с версией 1.1 Triple-S. Dim bSuccess ' "Истина", если экспорт завершился удачно Dim bUserCancelled ' "Истина", если пользователь отменил диалог с запросом пути к папке Dim sExportTo ' Хранит путь к папке назначения экспорта Dim objSpssData As ISpssDataDoc ' Хранит ссылку на текущий документ данных SPSS Dim objSpssOutputDoc As ISpssOutputDoc ' Хранит ссылку на текущий документ результатов SPSS Dim Index As Long ' Хранит индекс обрабатываемой переменной Dim NumVars As Long ' Хранит число переменных Dim NumCases As Long ' Хранит число наблюдений Dim pNames As Variant ' Массив для хранения имен переменных Dim pLabels As Variant ' Массив для хранения меток переменной Dim pMsmtLevels As Variant ' Массив для хранения типа шкалы переменных Dim pLabelCounts As Variant ' Массив для хранения числа меток значений у каждой переменной Dim pTypes As Variant ' Массив для хранения типов переменных Dim pFormats As Variant ' Массив для хранения форматов переменных Dim pWidths As Variant ' Массив для хранения размеров переменных (width) Dim pFracs As Variant ' Массив для хранения число десятичных знаков у переменной Dim pColumnWidths As Variant ' Массив для хранения ширины колонки переменной Dim pJust As Variant ' Массив для хранения выравнивания у переменных Dim pValLabels As Variant ' Массив для хранения меток значений переменных Dim pValues As Variant ' Массив для хранения значений, ассоциированных с метками значений Dim startTime As Date ' Хранит время начала выполнения процедуры Dim stopTime As Date ' Хранит время окончания выполнения процедуры Dim currIndent As String ' Хранит символ отступа (TAB) Dim Options As String ' Для хранения различных опций XML Dim IsSingle As Boolean ' Для хранения признака, что тип переменной - Single Dim isCharacter As Boolean ' Для хранения признака, что тип переменной - Character Dim isQuantity As Boolean ' Для хранения признака, что тип переменной - Quantity Dim currPos As Long ' Хранит текущую позицию начала данных Dim WtVar As String ' Хранит имя переменной взвешивания, если есть Dim Range_Min As String ' Для хранения минимального значения переменной типа Quantity Dim Range_Max As String ' Для хранения максимального значения переменной типа Quantity Dim objOutputItems As ISpssItems Dim objOutputItem As ISpssItem Dim sComment As String ' Хранит SPSS-форматы для переменных, экспортированных в тип Character Dim WeightVar As Boolean ' Признак того, что некоторая переменная использована для взвешивания Dim NumNeg As Long Dim NegativeValues As Boolean 'ставим ссылку на текущий документ данных SPSS Set objSpssData = objSpssApp.Documents.GetDataDoc(0) 'Если пользователь передал в скрипт параметр с путём для экспорта, используем его. Иначе - запрашиваем у пользователя через диалог. sExportTo = objSpssApp.ScriptParameter (0) If Len(sExportTo) = 0 Then Dim sDefaultPath As String sDefaultPath = Left(objSpssData.GetDocumentPath,Len(objSpssData.GetDocumentPath)-4) & "_SSS.xml" sExportTo = InputBox("Введите путь назначения экспорта:","Экспорт из SPSS в Triple-S",sDefaultPath) 'Проверка, на нажал ли пользователь "Отмена". Если нажал, аккуратно выходим из процедуры. If Len(sExportTo) = 0 Then bUserCancelled = True GoTo EndOfSub End If End If 'Начало процесса startTime = Now() ' Ставим ссылку на документ назначенного окна результатов If objSpssApp.Documents.OutputDocCount = 0 Then ' открываем новое окно, если ещё нет открытых. Set objSpssOutputDoc=objSpssApp.NewOutputDoc Else '...а если есть - ставим на него ссылку Set objSpssOutputDoc=objSpssApp.Documents.GetOutputDoc(0) End If objSpssOutputDoc.Visible=True Set objOutputItems = objSpssOutputDoc.Items If objOutputItems.Count()=0 Then Set objOutputItem = objOutputItems.GetItem(objOutputItems.Count()) Else Set objOutputItem = objOutputItems.GetItem(objOutputItems.Count()-1) End If objOutputItem.Current=True ' Добавляем новый элемент в выдачу, определяем его метку и заголовок objSpssOutputDoc.InsertHeading("Triple-S v" & Format(Triple_SVersion,"0.0") & " Экспорт") Set objOutputItem = objOutputItems.GetItem(objOutputItems.Count()-1) objOutputItem.Current=True objSpssOutputDoc.Promote objSpssOutputDoc.InsertTitle("Title","Triple-S v" & Format(Triple_SVersion,"0.0") & " Экспорт") 'Загрузка информации о переменных в окне данных SPSS Call objSpssData.GetVariableInfo(pNames, pLabels, pTypes, pMsmtLevels, pLabelCounts) Call objSpssData.GetVariableFormats(pFormats, pWidths, pFracs) 'Определяем число переменных NumVars = objSpssData.GetNumberOfVariables ' проверка существования весовой переменной If Triple_SVersion >= 1.2 Then ' проверка, экспортируем ли в версию Triple-S не ниже 1.2 WtVar=objSpssData.GetWeightingVariable(False) Else WtVar="" End If ' открываем файл для вывода xml Open sExportTo For Output As #1 ' открываем журнальный файл и записываем заголовки Open Left(sExportTo,Len(sExportTo)-4) & ".lst" For Output As #2 Print #2,"Схема экспорта данных в Triple-S для " & Left(sExportTo,Len(sExportTo)-4) & ".DAT" Print #2 Print #2,"ПЕРЕМ. " & vbTab & "ТИП " & vbTab & "ШИРИНА" & vbTab & "НАЧ. " & vbTab & "КОНЕЦ " & vbTab & "ФОРМАТ " & vbTab & "КОММЕНТ. " Print #2,"--------" & vbTab & "----" & vbTab & "------" & vbTab & "----- " & vbTab & "------ " & vbTab & "------ " & vbTab & "------- " ' запись заголовочной информации sss Call WriteSSSHeader(1,Triple_SVersion) ' запись комментария для обозначения исходных данных Call writeCommentElement(1,"Triple-S v" & Format(Triple_SVersion,"0.0") & " Экспорт файла данных SPSS " & objSpssData.GetDocumentPath,currIndent) ' открываем элемент survey Call WriteOpenElement(1,"survey","",currIndent) ' открываем элемент record Call WriteOpenElement(1,"record"," ident=""A""",currIndent) ' начало обработки переменных файла данных SPSS currPos=1 For i=0 To NumVars-1 'инициализация переменных WeightVar=False Options="" IsSingle = False isCharacter=False isQuantity=False ' определим тип переменной Select Case pFormats(i) Case SpssPrintFormatF ' обработка только числовых F-форматов, все прочие обрабатываются как строковые If pLabelCounts(i) = 0 Then ' если нет меток значений, экспортируем как Quantity Options=" ident=""" & Format(i+1,"0") & """ type=""quantity""" isQuantity=True Else ' определены метки значений, тип - Single IsSingle=True Options=" ident=""" & Format(i+1,"0") & """ type=""single""" ' теперь обрабатываем метки значений, и проверяем, нет ли меток для неположительных чисел ' загружаем все метки Call objSpssData.GetVariableValueLabels (i, pValues, pValLabels) ' для каждой метки NumNeg=0 NegativeValues=False For K=0 To pLabelCounts(i)-1 If Len(pValLabels(k))=0 Then pValLabels(k)=Str(pValues(k)) End If ' отлов отрицательных значений If pValues(k) <=0 Then If pValues(k) <> 0 Then NumNeg=NumNeg+1 End If NegativeValues=True End If Next k If pFracs(i) <> 0 Or (NegativeValues And NumNeg >= 1 ) Or (NegativeValues And pLabelCounts(i)=1) Then ' особые случаи - не можем экспортировать как Single, экспортируем как Quantity ' обрабатываем как Single, но экспортируем в тип Quantity Options=" ident=""" & Format(i+1,"0") & """ type=""quantity""" isQuantity=True End If End If ' проверка на то, не является ли переменная весовой If pNames(i)=WtVar Then ' если да, то добавляем к опциям информацию о взвешивании Options=" ident=""" & Format(i+1,"0") & """ type=""quantity""" Options=Options & " use=""weight""" ' она также должа быть экспортирована в Quantity, даже если она подходит под тип Single isQuantity=True WeightVar=True End If Case Else ' переменные прочих типов экспортируются в символьный тип Options=" ident=""" & Format(i+1,"0") & """ type=""character""" isCharacter = True End Select ' открываем элемент variable (начинается запись информации о переменной) Call WriteOpenElement(1,"variable",Options,currIndent) ' записываем элемент name Call WriteFullElement(1,"name",Trim(pNames(i)),"",currIndent) If pLabels(i)="" Then pLabels(i)=pNames(i) End If ' записываем элемент label Call WriteFullElement(1,"label",Trim(pLabels(i)),"",currIndent) ' вычисляем позицию Options=" start=""" & Format(currPos,"0") & """" If pWidths(i) <> 1 Then Options=Options & " finish=""" & Format(currPos+pWidths(i)-1,"0") & """" End If ' записываем элемент position Call WriteFullElementShort(1,"position",Options,currIndent) Options="" If isCharacter Then ' записываем в схему данных информацию для символьных переменных Call WriteLog(2,Format(pNames(i)),"C",Format(pWidths(i),"0"),Format(currPos,"0"),Format(currPos+pWidths(i)-1,"0"),"A" & Format(pWidths(i),"0") ,GetFormats(pFormats(i))) ' записываем элемент size Call WriteFullElement(1,"size",Format(pWidths(i),"0"),"",currIndent) End If If Not isCharacter Then ' открываем элемент values Call WriteOpenElement(1,"values","",currIndent) If isQuantity Then' т.к. тип - Quantity, печатаем размах значений (элемент range) Call getMin_MaxVal(pWidths(i),pFracs(i),Range_Min,Range_Max) Options=" from=""" & Range_Min & """ to=""" & Range_Max & """" ' записываем элемент range Call WriteFullElementShort(1,"range",Options,currIndent) End If If IsSingle Then ' для каждой метки... For K=0 To pLabelCounts(i)-1 fmt="0" If pFracs(i) > 0 Then ' устанавливаем формат вывода значений fmt="0." & String$(pFracs(i),"0") End If ' записываем элемент value ' особый случай, когда тип Single, но присутствует только одна метка, и та - для нулевого значения If pValues(k)=0 And Not isQuantity And NegativeValues Then ' записываем как комментарий Call writeCommentElement(1,"value code=""" & Format(pValues(k),fmt) & """ " & pValLabels(k) & " /value",currIndent) Else Call WriteFullElement(1,"value",pValLabels(k)," code=""" & Format(pValues(k),fmt) & """",currIndent) End If Next k End If ' закрываем элемент values Call WriteCloseElement(1,"values",currIndent) ' записываем в схему данных информацию для числовых переменных If IsSingle And Not isQuantity Then If Not NegativeValues Then Call WriteLog(2,Format(pNames(i)),"S",Format(pWidths(i),"0"),Format(currPos,"0"),Format(currPos+pWidths(i)-1,"0"),"F" & Format(pWidths(i),"0") & "." & Format(pFracs(i),"0"),"") Else ' особый случай - одна метка, для нуля Call WriteLog(2,Format(pNames(i)),"S",Format(pWidths(i),"0"),Format(currPos,"0"),Format(currPos+pWidths(i)-1,"0"),"F" & Format(pWidths(i),"0") & "." & Format(pFracs(i),"0"),"zero-value") End If End If If IsSingle And isQuantity Then If WeightVar Then Call WriteLog(2,Format(pNames(i)),"Q",Format(pWidths(i),"0"),Format(currPos,"0"),Format(currPos+pWidths(i)-1,"0"),"F" & Format(pWidths(i),"0") & "." & Format(pFracs(i),"0"),"weight-labelled") Else Call WriteLog(2,Format(pNames(i)),"Q",Format(pWidths(i),"0"),Format(currPos,"0"),Format(currPos+pWidths(i)-1,"0"),"F" & Format(pWidths(i),"0") & "." & Format(pFracs(i),"0"),"labelled") End If End If If isQuantity And Not IsSingle Then If WeightVar Then Call WriteLog(2,Format(pNames(i)),"Q",Format(pWidths(i),"0"),Format(currPos,"0"),Format(currPos+pWidths(i)-1,"0"),"F" & Format(pWidths(i),"0") & "." & Format(pFracs(i),"0"),"weight") Else Call WriteLog(2,Format(pNames(i)),"Q",Format(pWidths(i),"0"),Format(currPos,"0"),Format(currPos+pWidths(i)-1,"0"),"F" & Format(pWidths(i),"0") & "." & Format(pFracs(i),"0"),"") End If End If End If ' закрываем элемент variable Call WriteCloseElement(1,"variable",currIndent) ' увеличение счётчика с текущим столбцом currPos=currPos+pWidths(i) Next i ' закрываем элемент record Call WriteCloseElement(1,"record",currIndent) ' закрываем элемент survey Call WriteCloseElement(1,"survey",currIndent) ' закрываем элемент sss Call WriteCloseElement(1,"sss","") ' закончили записывать SSS xml ' теперь - экспорт данных с использованием синтаксиса SPSS - для файла данных - тот же префикс, что и для XML, но расширение - .DAT strCommand="WRITE OUTFILE='" & Left(sExportTo,Len(sExportTo)-4) & ".DAT' NoTable/ all." strcommand=strcommand & vbCrLf & "Execute." ' выполнение команды экспорта objSpssApp.ExecuteCommands strCommand, False ' используем асинхронный вариант соисполнения синтаксиса и скрипта Do DoEvents Loop Until Not objSpssApp.IsBusy ' обрабатываем асинхронное соисполнение (эффективный вариант синхронизации) ' окончание экспорта, ставим признак успешного завершения bSuccess = True EndOfSub: 'выгружаем объекты из памяти, закрываем открытые файлы On Error Resume Next Set objSpssApp = Nothing Close #1 Close #2 On Error GoTo 0 If bSuccess = True Then objSpssOutputDoc.Visible=True ' вставляем схему данных в документ Output (окно выдачи) SendKeys "%IF~" & Left(sExportTo,Len(sExportTo)-4) & ".lst" & "~" ,True ' вставка текстового файла ('в ранних версиях может потребоваться использовать "%IX~" - примеч. перев.) stopTime = Now() sMsg = "Файл успешно экспортирован в " & sExportTo & vbCrLf & "(Это заняло " & Format((stopTime - startTime), "nn:ss") & ")" & vbCrLf & " Данные сохранены в " & Left(sExportTo,Len(sExportTo)-4) & ".DAT" MsgBox sMsg,,"Экспорт из SPSS в Triple-S" Else If bUserCancelled = False Then MsgBox "Возникли проблемы! Экспорт не завершён.",,"Экспорт из SPSS в Triple-S" End If End Sub Sub WriteSSSHeader(Fn As Integer,Triple_SVersion As Double) ' запись заголовочной части для triple-s Dim tempIndent As String Print #Fn , "" Print #Fn ' запись элемента doctype в виде комментария Call writeCommentElement(Fn,"DOCTYPE sss PUBLIC ""-//triple-s//DTD Survey Interchange v" & Format(Triple_SVersion,"0.0") &"//EN"" ""http://www.triple-s.org/dtd/sss_v" & Format(Triple_SVersion*10,"0") & ".dtd""",tempIndent) ' если хотите проверить валидность создаваемого при экспорте XML-кода, используйте следующую строку вместо предыдущей (это требует доступа в интернет) ' Call WriteOpenElement(Fn,"!DOCTYPE", "sss PUBLIC ""-//triple-s//DTD Survey Interchange v" & Format(Triple_SVersion,"0.0") &"//EN"" ""http://www.triple-s.org/dtd/sss_v" & Format(Triple_SVersion*10,"0") & ".dtd""",tempIndent) Print #Fn ' стандарты именования в SPSS немного отличаются от стандартов в SSS - SPSS допускает символы '_.&$#' в именах переменных ' Call WriteOpenElement(Fn,"sss"," version=""" & format(Triple_SVersion,"0.0") & """ options=""standardnames""",tempIndent) Call WriteOpenElement(Fn,"sss"," version=""" & Format(Triple_SVersion,"0.0")& """",tempIndent) Print #Fn Call WriteFullElement(Fn,"date",Format(Date,"dd-mmmm-yyyy"),"","") Call WriteFullElement(Fn,"time",Format(Time,"hh:nn:ss"),"","") Call WriteFullElement(Fn,"origin","SPSS Script Export2Triple-S v1.1 - SPSS for Windows","","") End Sub Sub WriteFullElement(Fn As Integer,tag As String,contents As String,Options As String,currIndent As String) ' записывает элемент целиком в 1 строку; содержимое "вычищается" с помощью функции TextClean Print #Fn,currIndent & "<" & tag & Options & ">" & TextClean(contents) & "" End Sub Sub WriteFullElementShort(Fn As Integer,tag As String,Options As String,currIndent As String) ' записываем элемент без содержания на одной строчке Print #Fn,currIndent & "<" & tag & Options & "/>" End Sub Sub WriteOpenElement(Fn As Integer,tag As String,Options As String,currIndent As String) ' записываем открывающий элемент с опциями Print #Fn,currIndent & "<" & tag & Options & ">" ' увеличиваем отступ (для создания визуальной структуры) currIndent=currIndent & vbTab End Sub Sub WriteCloseElement(Fn As Integer,tag As String,currIndent As String) ' переходим на предыдущий уровень отступа If Len(currIndent)>0 Then currIndent=Left(currIndent,Len(currIndent)-1) End If ' запись закрывающего элемента Print #Fn,currIndent & "" End Sub Sub WriteCommentElement(Fn As Integer,contents As String,currIndent As String) ' записывает элемент комментария, перед этим удаляет возможные символы "--" в его содержании (заменяет на " ") ' и добавляет пробел в комментарии, заканчивающиеся на "-" If Mid(contents,Len(contents),1)="-" Then contents=contents & " " End If Print #Fn,currIndent & "" ' N.B. Комментарии не нужно пропускать через функцию TextCleaning - xml-комментарии могут содержать любые символы, за исключением -- End Sub Sub getMin_MaxVal(width As Variant,dp As Variant,Range_Min As String,Range_Max As String) Dim work As String ' определяем минимальные и максимальные значения текущей переменной на основе её ширины (width) в ' output-формате и числа десятичных знаков work=String$(width,"9") Range_Max=work If width = 1 Then Range_Min="0" Else Range_Min="-" & Left(work,Len(work)-1) End If If dp > 0 Then Range_Min=Left(Range_Min,width-dp-1) & "." & String$(dp,"9") Range_Max=Left(Range_Max,width-dp-1) & "." & String$(dp,"9") End If End Sub Sub WriteLog(Fn As Integer,string1 As String,string2 As String,string3 As String,string4 As String,string5 As String,string6 As String,string7 As String) ' запись отформатированных строк в схему данных string1= PadtoLen(string1,8) string2= PadtoLen(string2,4) string3= PadtoLen(string3,5) string4= PadtoLen(string4,8) string5= PadtoLen(string5,8) string6= PadtoLen(string6,8) Print #Fn,string1 & vbTab & string2 & vbTab & string3 & vbTab & string4 & vbTab & string5 & vbTab & string6 & vbTab & string7 End Sub Function PadtoLen(InString As String,maxlen As Integer) As String ' обрезаем/дополняем пробелами строки для достижения фиксированной длины Dim i i=Len(InString) If i < maxlen Then PadtoLen=InString & String(maxlen-i," ") Else PadtoLen=Left(InString,maxlen) End If End Function Function GetFormats(FormatCode As Variant) As String ' создаёт строку, указывающую на print-формат текущей переменной (для числовых форматов, отличных от F) Select Case FormatCode Case SpssPrintFormatA GetFormats="" ' строковый формат, ok Case SpssPrintFormatAhex GetFormats="hex" Case SpssPrintFormatComma GetFormats="comma" Case SpssPrintFormatDollar GetFormats="dollar" Case SpssPrintFormatF GetFormats="" ' числовой формат, ok Case SpssPrintFormatIb GetFormats="binary" Case SpssPrintFormatPibhex GetFormats="binary" Case SpssPrintFormatP GetFormats="binary" Case SpssPrintFormatPib GetFormats="binary" Case SpssPrintFormatPk GetFormats="binary" Case SpssPrintFormatRb GetFormats="binary" Case SpssPrintFormatRbhex GetFormats="binary" Case SpssPrintFormatZ GetFormats="zoned" Case SpssPrintFormatN GetFormats="integer" Case SpssPrintFormatE GetFormats="sci not" Case SpssPrintFormatDate GetFormats="date" Case SpssPrintFormatTime GetFormats="time" Case SpssPrintFormatDatetime GetFormats="datetime" Case SpssPrintFormatAdate GetFormats="date" Case SpssPrintFormatJdate GetFormats="date" Case SpssPrintFormatDtime GetFormats="time" Case SpssPrintFormatWkday GetFormats="date" Case SpssPrintFormatMonth GetFormats="date" Case SpssPrintFormatMoyr GetFormats="date" Case SpssPrintFormatQyr GetFormats="date" Case SpssPrintFormatWkyr GetFormats="date" Case SpssPrintFormatPct GetFormats="percent" Case SpssPrintFormatDot GetFormats="dot" Case SpssPrintFormatCca GetFormats="currency" Case SpssPrintFormatCcb GetFormats="currency" Case SpssPrintFormatCcc GetFormats="currency" Case SpssPrintFormatCcd GetFormats="currency" Case SpssPrintFormatCce GetFormats="currency" Case SpssPrintFormatEdate GetFormats="date" Case SpssPrintFormatSdate GetFormats="date" Case Else ' неизвестный формат; просто помечаем как неизвестный (unknown) GetFormats="unknown" End Select End Function Function TextClean(InString As String) As String ' вычищает из строки все символы с кодами вне интервала 32-127 (заменяет на коды) и прочие спецсимволы Dim i As Long Dim iLen As Long Dim TextVal As Integer TextClean="" iLen=Len(InString) For i=1 To iLen TextVal=Asc(Mid(InString,i,1)) Select Case TextVal Case 0 To 31 TextClean=TextClean & "&#" & Format(TextVal,"0") & ";" Case 34 TextClean=TextClean & """ Case 38 TextClean=TextClean & "&" Case 39 TextClean=TextClean & "'" Case 60 TextClean=TextClean & "<" Case 62 TextClean=TextClean & ">" Case 127 TextClean=TextClean & "
" Case 128 To 255 TextClean=TextClean & "&#" & Format(TextVal,"0") & ";" Case Else ' ok: в нужном интервале кодов (32-127) без спецсимволов - т.е. просто добавляем очередной проверенный символ TextClean=TextClean & Chr(TextVal) End Select Next i End Function