'Сохраните этот файл как "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