Dim ExcelApp ' ****************************************************** ' オブジェクト作成 ' ****************************************************** Function ExcelInit() If Not IsObject(ExcelApp) Then Set ExcelApp = CreateObject("Excel.Application") End If End Function ' ****************************************************** ' ブックを開く(Workbookを返す) ' ****************************************************** Function ExcelOpen(strPath) ExcelInit Set ExcelOpen = ExcelApp.Workbooks.Open(strPath) ' アクティブなウィンドウを最大化 ExcelApp.ActiveWindow.WindowState = 2 End Function ' ****************************************************** ' 表示状態の変更 ' ****************************************************** Function ExcelVisible(bFlg) ExcelInit ExcelApp.Visible = bFlg End Function ' ****************************************************** ' 終了 ' ****************************************************** Function ExcelQuit(WorkBook) If TypeName(WorkBook) = "Workbook" Then ' 保存した事にする WorkBook.Saved = True End If If IsObject(ExcelApp) Then ExcelApp.Quit Set ExcelApp = Nothing End If ExcelApp = "" End Function ' ****************************************************** ' シート名によるシート選択 ' ****************************************************** Function ExcelSelectSheet(MyBook, strSheetName) MyBook.Sheets(strSheetName).Select End Function ' ****************************************************** ' 番号よるシート選択 ' ****************************************************** Function ExcelSelectSheetByNo(MyBook, No) MyBook.Sheets(No).Select End Function ' ****************************************************** ' シート名によるシート複写 ' ****************************************************** Function ExcelCopySheet(MyBook, strSheetName, strNewSheetName) MyBook.Sheets(strSheetName).Copy (MyBook.Sheets(strSheetName)) MyBook.ActiveSheet.Name = strNewSheetName End Function ' ****************************************************** ' シート名によるシート名変更 ' ****************************************************** Function ExcelRenameSheet(MyBook, strSheetName, strNewSheetName) MyBook.Sheets(strSheetName).Name = strNewSheetName End Function ' ****************************************************** ' 上書き保存 ' ****************************************************** Function ExcelSave(MyBook) MyBook.Save End Function ' ****************************************************** ' 名前を付けて保存 ' ****************************************************** Function ExcelSaveAs(MyBook, strFileName) MyBook.SaveAs strFileName End Function ' ****************************************************** ' セルへのデータセット ' ****************************************************** Function ExcelSetCell(MyBook, strSheetName, x, y, Data) MyBook.Sheets(strSheetName).Cells(y, x) = Data End Function ' ****************************************************** ' シートの数 ' ****************************************************** Function ExcelGetSheetCount(MyBook) ExcelGetSheetCount = MyBook.Sheets.Count End Function ' ****************************************************** ' テスト ' ****************************************************** function Test(MyBook) MyBook.Sheets(TargetSheet).Activate MyBook.ActiveSheet.Range("A1:A1").Select end function ' ****************************************************** ' シート追加 ' ****************************************************** function AddSheetLast( MyBook, SheetName ) Dim Worksheet Dim Worksheet2 Dim nSheets nSheets = MyBook.Worksheets.Count Set Worksheet = MyBook.Worksheets( nSheets ) Worksheet.Activate Call MyBook.Worksheets.Add(,Worksheet) Set Worksheet2 = MyBook.ActiveSheet on error resume next Worksheet2.Name = SheetName on error goto 0 AddSheetLast = Worksheet2.Name end function