質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.49%

  • VBScript

    221questions

    VBScript(Visual Basic Scripting Edition)はMicrosftが開発したスクリプト言語であり、Visual Basicのサブセットです。

【VBS】Excelセルコピーが画像(?)になってしまう

解決済

回答 1

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 329

irohamaru

score 5

以下のVBScriptで、「コピー元のExcelファイルの指定セルの文字列を、コピー先のExcelファイルにペーストする」という処理を実現しようと思っています。

<フォルダ構成>
イメージ説明

コピー元フォルダの中にコピー対象のExcelファイルを配置
イメージ説明

テンプレートフォルダの中にペーストするExcelファイルを配置。
コピー元フォルダに配置されたExcelファイルの数の分複製される。
イメージ説明

実行したところ、以下のようにコピーしたセルが画像のような形でペーストされており、意図した結果でないため困っています。

イメージ説明

コピーの仕方が悪いのか、ペーストの仕方が悪いのか、
どなたか原因が分かる方がいらっしゃったらご教示願います。

Option Explicit

' ======================================================================================
' 変数定義
' 
' ======================================================================================

Dim objFSO             ' FileSystemObject
Dim baseFolder         ' 作業フォルダパス
Dim copyFolder         ' コピー元フォルダパス
Dim pasteFolder        ' コピー先フォルダパス
Dim copySheetName      ' コピー元シート名
Dim copyRange          ' コピー元セル範囲

Dim pasteSheetName     ' コピー先シート名

Dim templateFileName   ' テンプレートファイル名
Dim templateFolder     ' テンプレートファイルが配置されたフォルダパス

' ======================================================================================
' パラメータ設定(環境に合わせて定義すること)
' 
' ======================================================================================

copySheetName = "フォーマット" ' コピー元シート名
copyRange = "[B6:E6],[B9:D10],[G7:AJ106]" ' コピー元セル範囲(複数の範囲指定⇒(例)"[A1:A2],[B1,B2]")

pasteSheetName = "フォーマット" ' コピー先シート名

templateFileName = "template.xlsx"


' ======================================================================================
' EXCELコピー&ペースト
'
' ======================================================================================
' フォルダパス設定
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
If Err.Number = 0 Then
    Dim currentDir
    currentDir = objFSO.getParentFolderName(WScript.ScriptFullName)
    copyFolder = currentDir & "\" & "コピー元"
    pasteFolder = currentDir & "\" & "コピー先"
    templateFolder = currentDir & "\" & "テンプレート"
Else
    WScript.Echo "エラーが発生したため終了します。"
    WScript.Quit
End If

' コピー元セル範囲をリスト化
Dim RangeList
RangeList = Split(copyRange, ",")

'エラー情報をクリアする。
Err.Clear


' フォルダ内(サブフォルダも含む)でループしてコピー元ファイルを取得
ShowSubfolders objFSO.GetFolder(copyFolder)

Dim File
Sub ShowSubFolders(Folder)
    For Each File in Folder.Files 'フォルダ内のファイルを列挙する
        'EXCELファイルか判定
        Dim ext
        ext = objFSO.GetExtensionName(File.Name)

        If ext = "xlsx" Or ext = "xlsm" Then
            ' 変数定義
            Dim copyFilePath, pasteFilePath, templateFilePath, copyExcelObj, pasteExcelObj
            Dim copyFileObj, pasteFileObj, copySheetObj, pasteSheetObj

            templateFilePath = templateFolder & "\" & templateFileName
            copyFilePath = copyFolder & "\" & File.Name
            pasteFilePath = pasteFolder & "\" & File.Name

            ' コピー元と同じファイル名でコピー先ファイルを生成
            objFSO.CopyFile templateFilePath, pasteFilePath, True

            ' コピーエラー発生時は終了する
            If Err.Number <> 0 Then
                Set File = Nothing
                Set objFSO = Nothing

                WScript.Echo "テンプレートコピーでエラーが発生したため終了します。"
                WScript.Quit
            End If

            ' コピー元ファイルを開く
            Set copyExcelObj = WScript.CreateObject("Excel.Application")
            Set copyFileObj = copyExcelObj.Workbooks.Open(copyFilePath)
            Set copySheetObj = copyFileObj.Worksheets(copySheetName)


            ' コピー先ファイルを開く
            Set pasteExcelObj = WScript.CreateObject("Excel.Application")
            Set pasteFileObj = pasteExcelObj.Workbooks.Open(pasteFilePath)
            Set pasteSheetObj = pasteFileObj.Worksheets(pasteSheetName)

            pasteSheetObj.Activate

            ' コピー対象セル範囲を取得(リストで保持)
            Dim RangeVal
            For Each RangeVal in RangeList
                RangeVal = Replace(Replace(RangeVal, "[", ""), "]", "")

                copySheetObj.Range(RangeVal).Copy

                ' コピー先ファイルにペースト
                'pasteSheetObj.Range("A1").Select
                ' -4104
                pasteSheetObj.Range(RangeVal).PasteSpecial(-4104)

            Next

            pasteFileObj.Save
            pasteFileObj.Close

            copyExcelObj.Quit
            pasteExcelObj.Quit

        Else
            WScript.Echo "テンプレートコピーに失敗しました。"
            WScript.Quit
        End If
    Next

    Dim Subfolder
    For Each Subfolder in Folder.SubFolders 'フォルダ内のフォルダを列挙する
        ShowSubFolders Subfolder '再帰呼び出し
    Next
End Sub

WScript.Echo "テストデータコピーが完了しました。"
WScript.Quit

Set copyExcelObj = Nothing
Set copyFileObj = Nothing
Set copySheetObj = Nothing

Set pasteExcelObj = Nothing
Set pasteFileObj = Nothing
Set pasteSheetObj = Nothing

Set File = Nothing
Set objFSO = Nothing

Set Subfolder = Nothing
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 1

checkベストアンサー

+1

色々調べてみましたけど原因不明です。
値のみのコピーで良いならPasteSpecial(-4163)とすることで可能です。
ただし、以下の警告が出てしまいます。

貼り付けようとしているデータと選択した領域のサイズと異なります。貼り付けますか?

こちらも理由はわかりませんでした。
G7:AJ106のときのみ出るので、範囲が広いと出るのかもしれません。
こちらの仮対処としては、貼り付け時の範囲を左上のみを指定することで回避できました。

rs = Split(RangeVal, ":")
pasteSheetObj.Range(rs(0)).PasteSpecial(-4163)

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/06/26 17:31

    わざわざ調べてくださり、ありがとうございます!
    根本的な原因は気になりますが、とりあえず回避策が見つかっただけでも感謝です。
    ありがとうございました!

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.49%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

  • 解決済

    ファイルを開かずにヘッダーヘッターの取得

    いつも丁寧な解答をありがとうございます。 今回はexcel2010のVBAについて教えて下さい。 やりたいこととしては、フォルダ内にあるすべてのExcelブックのファイ

  • 解決済

    Excel 文字に値を設定

    ExcelでもJavaのようにA=5、B=2を設定しA+B=7のように計算できないのでしょうか?例えば この様な計算です。 方法があればご教示願います。

  • 解決済

    エクセル VBA 1つのセルの値を分けて、逆並びで列に配置

    教えてください。 F列2行目から例えば、 43x43x5(×は大文字のx(エックス)で代用してます。) というサイズ「縦x横x高さ」が入力されています。 これを数値ごと

  • 解決済

    1行ごとに入力されている各単語の数を数えたい

    閲覧ありがとうございます。 一単語が一行に入力されたtxtファイルの中の 各単語が何回出てきているかを調べたいのですが、どのようにすればよいでしょうか? 単語を指定し

  • 解決済

    カンマ区切りのデータの重複する要素とその値を合計したい

    閲覧ありがとうございます。 カンマ区切りのデータの重複する要素とその値を合計したいのですが、どのようにすればよいのでしょうか? とても大きなデータなので、excelでは開け

  • 受付中

    Excelで分単位でバラバラに記録されたデータから将来予測

    前提・実現したいこと 艦これの支援ソフト「航海日誌拡張版」から出力される資源ログのデータをもとに、指定日を初日として、このまま遠征等を続けたらいかほど資源が獲得できるかを将来予測す

  • 解決済

    Excel重複データのチェック

    エクセルで特定の列のセルにデータを入力した時に、同じ列内に重複データがある場合、 重複データの行の色を変えて、更に可能であれば、アラートで「●個目の重複データです」と表示させたいの

  • 受付中

    列を追加したら隣の書式・数式を引き継ぐようにしたい

    仕事で急遽頼まれてしまいましたが、どうしても検索しても見つからなかったため投稿させて頂きます。 今までは抜けている関数を手動で挿入していましたが、自動化をしたいとおもっております。

同じタグがついた質問を見る

  • VBScript

    221questions

    VBScript(Visual Basic Scripting Edition)はMicrosftが開発したスクリプト言語であり、Visual Basicのサブセットです。