1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
'Создание синтаксиса, описывающего метки переменных и значений. 

' Размещено в SPSSX-L 23.11.2003; автор: Alex Vinogradov.
' Скрипт создаёт синтаксис, который содержит определение меток переменных и их значений из
' файла данных.

Sub Main

Dim DataDoc As ISpssDataDoc, SyntaxDoc As ISpssSyntaxDoc
Dim VarNames,VarLabels,VarTypes,VarLevels,LabelCounts As Variant
Dim ValueLabelCounts,ValueLabels,Value As Variant
Dim i,j,numVars,NumValueLabels As Long, S, Temp, Delimiter As String

Set DataDoc = objSpssApp.Documents.GetDataDoc(0)
numVars = DataDoc.GetVariableInfo(VarNames, VarLabels, VarTypes, VarLevels, LabelCounts)

Set SyntaxDoc = objSpssApp.NewSyntaxDoc
SyntaxDoc.Visible = True

Delimiter = ""
S = "VARIABLE LABEL "
For i = 0 To numVars-1
        Temp = VarLabels(i)
        If Temp <> "" Then
                Temp = Replace(Temp, "'", "''")
                S = S & Delimiter & VarNames(i) & " " & Quote(Temp)
        End If
        Delimiter =  vbCrLf & "  /"
Next

Delimiter = ""
S = S & "." & vbCrLf & "VALUE LABELS "
For i = 0 To numVars-1
  NumValueLabels = DataDoc.GetVariableValueLabels (i, ValueLabelCounts, ValueLabels)
  If NumValueLabels > 0 Then
    S = S & Delimiter & VarNames(i)
    Delimiter =  vbCrLf & "  /"
    For j = 0 To NumValueLabels-1
      Value = ValueLabelCounts(j)
      If VarTypes(i) > 0 Then Value = Quote(Value)
      Temp = Replace(ValueLabels(j), "'", "''")
      S = S & " " &      Value & " " & Quote(Temp)
    Next
  End If
Next

SyntaxDoc.Text = S & "."

End Sub

Function Quote(S As Variant) As String
        Quote = Chr(39) & S & Chr(39)
End Function