tagCANDY CGI VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
[ツリー表示へ]  [ワード検索]  [Home]

タイトル Re^2: Excelのシートをコピーしたときのセルの表示書式
投稿日: 2008/01/24(Thu) 09:23
投稿者す〜
花ちゃんさん、ありがとうございます。そして、失礼いたしました。
職場外からでコードが書き込めませんでした。
以下がコードになります。
なお、元となるExcelファイルは前もってご用意ください。


Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim xlApplication As New Excel.Application()
        Dim xlInBooks As Excel.Workbooks
        Dim xlInBook As Excel.Workbook
        Dim i As Integer

        Try
            'Excelファイル(C:\Test_moto.xls)のSheet1の各セルには前もって値"2008/1/1"を代入しておき
            '[セルの書式設定]-[表示形式]で以下のように設定し保存しておく。
            'A1 = 未設定
            'A2 = 日付:yyyy/m/d
            'A3 = 日付:yyyy年m月d日
            'A4 = ユーザ定義:yyyy年mm月dd日
            'A5 = ユーザ定義:yyyy年m月d日
            'A6 = ユーザ定義:yyyy/mm/dd

            xlApplication.DisplayAlerts = False
            xlApplication.ScreenUpdating = False

            '元になるExcelファイルを開く
            xlInBooks = xlApplication.Workbooks
            xlInBook = xlInBooks.Open("C:\Test_moto.xls")

            'シートコピー
            For i = 1 To 9
                Call CE_ExcelSheetCopy(xlInBook, 1, i, False)
            Next

            'ファイルを別名で保存
            xlInBook.SaveAs("C:\test.xls")

            xlApplication.DisplayAlerts = True
            xlApplication.ScreenUpdating = True

            'COMオブジェクトを解放
            COM_MRComObject(xlInBook)
            xlInBooks.Close()
            COM_MRComObject(xlInBooks)
            xlApplication.Quit()
            COM_MRComObject(xlApplication)

            MessageBox.Show("End", "Test", MessageBoxButtons.OK)

        Catch ex As Exception
            MessageBox.Show(ex.Message, "Err", MessageBoxButtons.OK)
        End Try
    End Sub

    '*-------------------------------------------------------------------*
    ' 【機  能】Excelのシートコピー
    ' 【引 き 数】xlBook : Excelワークブック
    '             SheetNoMoto : コピー元シート番号
    '             SheetNoIchi : コピー位置のシート番号
    '             BeforeOrAfter : コピー位置の前(True)or後ろ(False)
    ' 【返 り 値】-
    '*-------------------------------------------------------------------*
    Public Sub CE_ExcelSheetCopy(ByVal xlBook As Excel.Workbook, ByVal SheetNoMoto As Integer, ByVal SheetNoIchi As Integer, ByVal BeforeOrAfter As Boolean)
        Dim xlSheets As Excel.Sheets
        Dim xlSheetMoto As Excel.Worksheet
        Dim xlSheetIchi As Excel.Worksheet

        Try
            'シートを指定位置にコピーする
            xlSheets = xlBook.Worksheets
            xlSheetMoto = DirectCast(xlSheets.Item(SheetNoMoto), Excel.Worksheet)
            xlSheetIchi = DirectCast(xlSheets.Item(SheetNoIchi), Excel.Worksheet)
            If BeforeOrAfter = True Then
                xlSheetMoto.Copy(xlSheetIchi)
            Else
                xlSheetMoto.Copy(, xlSheetIchi)
            End If

            'COMオブジェクトの解放
            COM_MRComObject(xlSheetMoto)
            COM_MRComObject(xlSheetIchi)
            COM_MRComObject(xlSheets)

        Catch ex As Exception
            MessageBox.Show(ex.Message, "Err", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try
    End Sub

    '*-------------------------------------------------------------------*
    ' 【機  能】COMオブジェクトの解放
    ' 【引 き 数】objCom : COMオブジェクト
    ' 【返 り 値】-
    '*-------------------------------------------------------------------*
    Public Sub COM_MRComObject(ByVal objCom As Object)
        Try
            If Not objCom Is Nothing AndAlso System.Runtime.InteropServices. _
                                                      Marshal.IsComObject(objCom) Then
                Dim I As Integer
                Do
                    I = System.Runtime.InteropServices.Marshal.ReleaseComObject(objCom)
                Loop Until I <= 0
            End If
        Catch
        Finally
            objCom = Nothing
        End Try
    End Sub
End Class

- 関連一覧ツリー をクリックするとツリー全体を一括表示します)

古いスレッドにレスはつけられません。