カード型データベースを作ってみよう

Step 13 データをコピーのコード修正

前回のコピー方法では、新規に作成したExcelにコピーされていませんでした。
いろいろやってみましたが、この方法ではうまくいかないようです。
従いましてクリップボードにコピーし、その後、貼り付ける方法に変更します。
又、これでは列幅はコピーされないので、ColumnWidthでコピー元と同じにします。

メニューに戻る

スポンサードリンク



実行画面

■コピー元のデータシート
コピー元のカード

■コピー先のデータシート
データと列幅も同じで、シート名も「DB一覧」に変更されています。
コピー先のカード

スポンサードリンク



実行コード

'一覧ボタン
Private Sub CommandButton3_Click()
    Dim App As Object
    Dim push As Integer
    Dim twb As Workbook

    '新規シート作成枚数をプッシュ
    push = Application.SheetsInNewWorkbook

    'Excelを起動
    Set App = CreateObject("Excel.Application")
    '表示する
    App.Visible = True
    
    'シートを1枚作成
    Application.SheetsInNewWorkbook = 1
    'ブックを追加する
    Set twb = App.Workbooks.Add
    
    '3列をコピーする
    Workbooks("Data.xls").Worksheets("Sheet1").Range("A:C").Copy   ' Destination:=Workbooks("c:\t0.xls").Worksheets("Sheet1").Cells
    '貼り付け
    App.Worksheets("Sheet1").Paste
    '列幅をコピー
App.Worksheets("Sheet1").Cells(1, 1).ColumnWidth = _
Workbooks("Data.xls").Worksheets("Sheet1").Cells(1, 1).ColumnWidth
App.Worksheets("Sheet1").Cells(1, 2).ColumnWidth = _
Workbooks("Data.xls").Worksheets("Sheet1").Cells(1, 2).ColumnWidth
App.Worksheets("Sheet1").Cells(1, 3).ColumnWidth = _
Workbooks("Data.xls").Worksheets("Sheet1").Cells(1, 3).ColumnWidth
    'コピー先のシート名を変更
    twb.Worksheets("Sheet1").Name = "DB一覧"
    
    '戻す
    Application.SheetsInNewWorkbook = push

End Sub

スポンサードリンク





メニューに戻る

■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します


関連コンテンツ

Copyright (c) Excel-Excel ! All rights reserved