Конвертация в формат Excel 5/95

 

Загрузить как .sbs Показать простым текстом

 

 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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
'Сохраните этот файл как "Convert to Excel 5/95 format.SBS"

'ОПИСАНИЕ
' Загружает файл xls в формате Excel 2.1 и сохраняет его в формате Excel 5/95.
' Скрипт может быть вызван из синтаксиса так, например:
' SCRIPT "c:\\temp\\Convert to Excel 5_95 format.SBS" ("c:\\temp\\test.xls").
'Конец ОПИСАНИЯ

'Размещено в SPSSX-L 13.07.2001, автор: rlevesque@videotron.ca

Const xlExcel5 = 39

Sub Main
	Dim strFileName As String
	strFileName = GetFileName
	Call SaveToExcel5(strFileName)
End Sub

Sub SaveToExcel5(strFileName As String)

	Dim objExcelApp As Object
	On Error GoTo Oopps

	' GetObject возвращает ссылку на открытое приложение Excel
	' Если он ещё не запущен, возникает ошибка, и обработчик ошибки запускает приложение
	Set objExcelApp = GetObject(,"Excel.Application")

	If strFileName = "" Then Exit Sub	' Пользователь не передал имя файла, выходим
	objExcelApp.Workbooks.Open strFileName
	objExcelApp.AlertBeforeOverwriting = False
	strFileName = Left(strFileName,Len(strFileName)-4) & "v5.xls"
	objExcelApp.ActiveWorkbook.SaveAs FileName:=strFileName, FileFormat:=xlExcel5
	objExcelApp.ActiveWorkbook.Close
	Set objExcelApp = Nothing
	Exit Sub
	
	Oopps:
	Select Case Err
		Case 10096
			Debug.Print "Excel не запущен, используем CreateObject"
			'CreateObject запускает Excel, если он не запущен к этому моменту
			If objExcelApp Is Nothing Then
			    Set objExcelApp = CreateObject("Excel.Application")
			End If
			Resume Next
		Case Else
			Debug.Print Err & " " & Err.Description
	End Select
End Sub

Function GetFileName() As String
	Dim strFileName As String
	'Первая проверка - на то, был ли вызван скрипт из синтаксиса с именем файла в качестве параметра
	On Error Resume Next
	'В SPSS 7.5 это должно вызывать ошибку
	strFileName = objSpssApp.ScriptParameter(0)
	If Err Then
		Err.Clear
	End If
	
	If strFileName <> "" Then
		GetFileName = strFileName
		Exit Function
	End If
	
	'Если имя файла не было передано в качестве параметра, запросим имя файла у пользователя
    Do
	    '0 означает, что пользователь указать существующий файл
	    strFileName = GetFilePath$("*.xls","xls",,"File to convert to Excel 5", 0)
	    If strFileName = "" Then	'пользователь отменил выбор
			GetFileName = ""
	    	Exit Function
	    End If
	Loop Until strFileName <> ""
	GetFileName = strFileName
End Function
Related pages

...

Navigate from here