'Это программа на VISUAL BASIC, которая должна бы быть конвертирована в VBA Access. 'Размещено в новостную группу SPSS. Автор: Thomas Zapf-Schramm , 7.4.2000 'Я долгое время использую SPSS и MS Access. Поскольку в MS Access нет меток переменных и значений в том смысле, 'в котором они есть в SPSS, мы ипользуем подстановочные ключевые таблицы, чтобы заменить эту возможность 'при составлении отчётов в БД или формах ввода данных. 'Когда требуется перейти от данных в Access к данным в SPSS, мне требуется небольшая программа '(выполняемая из БД Access, но её легко можно переделать на VB-скрипт или SAX Basic), 'которая конвертирует подстановочные таблицы в синтаксис SPSS, которые формирует желаемые метки в файле SPSS. 'Подстановочная таблица имеет 4 колонки: "Varname", "Varlabel", "Value" And "Vallabel". 'В ней зафиксированы все возможные значения каждой переменной в основной таблице БД. 'Следующая процедура VBA нуждается в установлении ссылки на библиотеку "Microsoft scripting runtime" для доступа 'к объекту FileSystemObject. Option Compare Database Option Explicit Public Sub MakeLabels(LabelTable As String, OutFileName As String) Dim aktDB As DATABASE Dim aktRS As Recordset Dim fs As New FileSystemObject Dim Outfile As TextStream Dim currVar As String Dim currVal As String Dim currVarlab As String Dim currValLab As String Dim lastVar As String Set aktDB = CurrentDb Set aktRS = aktDB.OpenRecordset(LabelTable, dbOpenDynaset) Set Outfile = fs.OpenTextFile(OutFileName, ForWriting, True) aktRS.MoveFirst lastVar = "" Outfile.Write ("VARIABLE LABELS") Do While Not aktRS.EOF currVar = aktRS("Varname") currVarlab = aktRS("Varlabel") If currVar <> lastVar Then Outfile.WriteLine Outfile.Write (" " & currVar & " '" & currVarlab & "'") End If lastVar = currVar aktRS.MoveNext Loop Outfile.WriteLine (".") Outfile.WriteLine Outfile.Write ("VALUE LABELS") aktRS.MoveFirst lastVar = "" Do While Not aktRS.EOF currVar = aktRS("Varname") If lastVar <> "" Then currVar = "/" & currVar currVal = CStr(aktRS("Value")) currValLab = aktRS("Vallabel") If currVar <> lastVar Then Outfile.WriteLine Outfile.WriteLine (" " & currVar) Outfile.Write (" " & Format(currVal, "0000") & " '" & currValLab & "'") Else Outfile.WriteLine Outfile.Write (" " & Format(currVal, "0000") & " '" & currValLab & "'") End If If lastVar = "" Then currVar = "/" & currVar lastVar = currVar aktRS.MoveNext Loop Outfile.WriteLine (".") aktRS.Close Outfile.Close Set aktRS = Nothing Set aktDB = Nothing Set Outfile = Nothing Set fs = Nothing End Sub