[[20220428180554]]　『別ファイルへ罫線を引くVBA』（梨）　ページの最後に飛ぶ

『別ファイルへ罫線を引くVBA』（梨）

こんばんは。

別ファイルへへ罫線を引くVBAを教えてほしいです。

ダイアルボックスで指定するファイルを開き、
マクロが入っているファイルのシートを別ファイルへコピーして貼り付けています。

貼り付けるまでは出来たのですが、その先の罫線を引くVBAが上手くいきません。

コードは
Dim wbSaki As Workbook
CreateObject("Wscript.shell").currentdirectory = "C:\Users\u51633020\Desktop\リスト"

    OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")

            Set wbSaki = Workbooks.Open(Path & SetFile)
               If OpenFileName <> "False" Then
                 SetFile = OpenFileName
                 fileName = Dir(OpenFileName)
            Workbooks.Open fileName:=SetFile, ReadOnly:=True, UpdateLinks:=0

          Set wbSaki = Workbooks.Open(Path & SetFile)
          wbSaki.Worksheets(1).Copy After:=wbSaki.Worksheets(1) '開いたワークシートの右隣にコピー

           '線を引く

            Dim MR As Long
            Dim MC As Long

           'MR = .Cells(Rows.Count, 1).End(xlUp).Row
           'MC = .Cells(8, Columns.Count).End(xlToLeft).Column
           'Range(.Cells(8, 2), .Cells(MR, MC)).Borders.LineStyle = True

           wbSaki.Save
           wbSaki.Close False  'マスターデータ取り込み先のファイルを閉じ
           End If
これで行っても引けませんでした。
希望はB7を起点にB列の最終行から文字が入っている最終列までの間を引きたいです

お願いします。

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

コメントにしていると、何も動作しません。
コメントを外すとエラーになりそうですが、
「With 〜」がないからかと。

ご参考。
https://www.google.com/search?q=vba+%E7%BD%AB%E7%B7%9A%E3%82%92%E5%BC%95%E3%81%8F

（わからん） 2022/04/28(木) 18:51

わからんさん。

以下の様に設定しました。

           Dim MR As Long
           Dim MC As Long
            With wbSaki.Worksheets(1)
           MR = .Cells(Rows.Count, 1).End(xlUp).Row
           MC = .Cells(8, Columns.Count).End(xlToLeft).Column
           Range(.Cells(8, 2), .Cells(MR, MC)).Borders.LineStyle = True
           End With
           wbSaki.Save
           wbSaki.Close False  'マスターデータ取り込み先のファイルを閉じ
           End If
Range(.Cells(8, 2), .Cells(MR, MC)).Borders.LineStyle = TrueでRangeクラスは失敗しました。
WorkSheetオブジェクトととでました。

（梨） 2022/04/28(木) 20:16

横からですが確認。

エラーになったとき「wbSaki」には何が入っていたのですか？
（提示するなら、Sub～End Subまで提示いただいたほうがお互いの誤解がなくてよいとおもいます。）

（もこな２） 2022/04/28(木) 20:29

Private Sub CommandButton2_Click()

    Dim OpenFileName, fileName, Path, SetFile As String
    Dim wwbSaki As Workbook

    CreateObject("Wscript.shell").currentdirectory = "C:\Users\linki\Desktop\出庫リスト"

            OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")

               If OpenFileName <> "False" Then
                 SetFile = OpenFileName
                 fileName = Dir(OpenFileName)
            Workbooks.Open fileName:=SetFile, ReadOnly:=True, UpdateLinks:=0

          Set wbSaki = Workbooks.Open(Path & SetFile)

           '線を引く

           Dim MR As Long
           Dim MC As Long
            With wbSaki.Worksheets(1)
           MR = .Cells(Rows.Count, 1).End(xlUp).Row
           MC = .Cells(8, Columns.Count).End(xlToLeft).Column
           Range(.Cells(8, 2), .Cells(MR, MC)).Borders.LineStyle = True
           End With
           wbSaki.Save
           wbSaki.Close False  'マスターデータ取り込み先のファイルを閉じ
           End If

End Sub
wbSakiはローカルウインドウで確認した所、何も入っていませんでした。
てっきり読み込んだファイル名が入っているかと思いました。
（梨） 2022/04/28(木) 20:39

Dim wwbSaki As Workbook
を
Dim wbSaki As Workbook
にの間違いでした。
（梨） 2022/04/28(木) 20:44

＞てっきり読み込んだファイル名が入っている
ファイル名を表示するなら、「wbSaki.Name」です。

こちらを修正してみてください。

  Range(.Cells(8, 2), .Cells(MR, MC)).Borders.LineStyle = True
　　　↓
 .Range(.Cells(8, 2), .Cells(MR, MC)).Borders.LineStyle = True

（わからん） 2022/04/28(木) 21:49

 Private Sub CommandButton2_Click()
    Dim OpenFileName, fileName, Path, SetFile As String
    Dim wwbSaki As Workbook
  CreateObject("Wscript.shell").currentdirectory = "C:\Users\linki\Desktop\出庫リスト"

            OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
            'ダイアログボックスを表示して、マスターデータファイルを指定します。

               If OpenFileName <> "False" Then
                 SetFile = OpenFileName
                 fileName = Dir(OpenFileName)

Application.CutCopyMode = False

            Workbooks.Open fileName:=SetFile, ReadOnly:=False, UpdateLinks:=0

             Set wbSaki = Workbooks.Open(Path & SetFile)

             wbSaki.Worksheets(1).Copy After:=wbSaki.Worksheets(1)
        wbSaki.Worksheets(2).Range("B7:B700,M7:M200,N7:N200,P7:P200,Q7:Q200,R7:R200,AE7:AE200").ClearContents

   Dim wb3 As Workbook
    Dim LstRow3 As Long
    Dim LstRow4 As Long

    Set wb3 = ThisWorkbook

        LstRow3 = wb3.Worksheets("転送シート").Cells(Rows.Count, 1).End(xlUp).Row
            wb3.Worksheets("転送シート").Range("O2:O600" & LstRow3).Copy
            Set ws = wbSaki.Worksheets(2)
        LstRow4 = ws.Cells(Rows.Count, 2).End(xlUp).Row + 1
            ws.Range("B" & LstRow4).PasteSpecial xlPasteValues

           Application.CutCopyMode = False

           Set ws = wbSaki.Worksheets(2)
           '線を引く

          Dim MR As Long
          Dim MC As Long

           MR = ws.Cells(Rows.Count, 2).End(xlDown).Row
          MC = ws.Cells(8, Columns.Count).End(xlToLeft).Column
          ws.Range(ws.Cells(8, 2), ws.Cells(MR, MC)).Borders.LineStyle = True
           wbSaki.Save
           wbSaki.Close

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End If

        End Sub
で行うと線は引かれました。
しかし、なぜか文字が入っているセルの最終セルは転送シートのO列は146行目なのですが
ctrl+↓で試すとなぜか163行目の空白セルになってしまいます。それを最終行と判断して線が引かれると思います。文字が入っているセルを最終行と判断させることはできますでしょうか？

この動作の前に
　　Worksheets("転送シート").Range("A2:A700").Copy

    Worksheets("転送シート").Range("O2:O700").PasteSpecial Paste:=xlPasteValues
 を行っているのですが、これは数式が入っている転送シートA列の値を同じ転送シートのO列に値のみ貼り付けているのですが、実際A列に数式が163行まで入っています。
これがなにか関係しているのですか？  
（梨） 2022/04/29(金) 07:42

＞これがなにか関係しているのですか？

ご参考。
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1478773794

（わからん） 2022/04/29(金) 08:04

わからんさん

参照のページをみて解決できました。

アドバイスありがとうございました。
（梨） 2022/04/29(金) 08:19

解決されたようで何より。

直接関係しませんが、気づいた点があります。

     Workbooks.Open fileName:=SetFile, ReadOnly:=False, UpdateLinks:=0
     Set wbSaki = Workbooks.Open(Path & SetFile)
と2回開いているのはおかしくないですか？

またSetFileは既にドライブ、フォルダ名がついているのに、Pathを追加するのは不思議。
Pathは宣言しただけで値をセットしていないので影響はないが、無駄と思います。

また、インデントをきちんとつける習慣をつけたほうが、ご自分のためによいと思いますよ。
（γ） 2022/04/29(金) 08:41

（γ）さん。
コメントありがとうございます。

Workbooks.Open fileName:=SetFile, ReadOnly:=False, UpdateLinks:=0

     Set wbSaki = Workbooks.Open(Path & SetFile)
は２回開いているとご指摘がありましたが
そうするとどちらかが不要とのことでしょうか？

Pathの方は訂正させてもらいます。
（梨） 2022/04/29(金) 09:29

書き溜めている間に解決したようですが投稿しておきます。

提示おつかれさまでした。全体を拝見して何点か。

■１

 Dim OpenFileName, fileName, Path, SetFile As String
↑のような書き方はダメではありませんが↓のように解釈されます。
 Dim OpenFileName As Variant, fileName As Variant, Path As Variant, SetFile As String

よって慣れてきたら↓のように適切な型を指定できるようになるとよいですね。

 Dim OpenFileName As String, fileName As String, Path As String, SetFile As String

■２
エクセル君の忖度で想定通り動きはするでしょうが、「OpenFileName」がVariant型である場合

 If OpenFileName <> "False" Then

↑は↓のようにしたほうが良いでしょう。

 If OpenFileName <> False Then

また、好みの問題ではありますが

 If ～～～～～～～～～
     処理
 End If

よりも、

 If ～～～～～～～ 条件を満たしたら処理中止
 処理

という書き方にしたほうが可読性が上がるように思います。

■３
「Application.GetOpenFilename」はそれ単体でファイルの【フルパス】を得ることができます。
そして↓でファイル名だけ取り出していますが、どこで使っているわけでもありません。

 fileName = Dir(OpenFileName)

なのでさっくりと削除してよろしいかとおもいます。

また、変数「Path」は値の取得をしている箇所がないので「""」のままです。
したがって↓は

 Set wbSaki = Workbooks.Open(Path & SetFile)
 Set wbSaki = Workbooks.Open(SetFile)

↑と同じことになります。
そして↓のようになっているのですから、【同じファイルを２度開く】ことになっています。

 Workbooks.Open fileName:=SetFile, ReadOnly:=True, UpdateLinks:=0
 Set wbSaki = Workbooks.Open(SetFile)

この部分はエラーにはなりませんが、無駄な工程であるようにおもいます。

■４
＞wbSakiはローカルウインドウで確認した所、何も入っていませんでした。
何も入ってないのではなく、「Dim wbSaki As Workbook」ですから、【開いたブック】がセットされていたのではありませんか？
[2022/04/28(木) 20:16]に提示された情報だけだと、その部分が見えなかったので「wbSaki」が空っぽ（Nothing）のままなのに操作しようとしたことがエラーの原因と考えて確認した次第です。

■５
＞希望はB7を起点にB列の最終行から文字が入っている最終列
そうであれば↓はおかしいです。

 Range(.Cells(8, 2), .Cells(MR, MC)).Borders.LineStyle = True
              ↑
             ここ

また、↓も正しく取得できているのか少々気がかりです

 MR = .Cells(Rows.Count, 1).End(xlUp).Row
 MC = .Cells(8, Columns.Count).End(xlToLeft).Column

「MR」は【A列の】最終行を求めてますし、「MC」は【8行目の】最終列を求めています。

■６
ということを踏まえて「2022/04/28(木) 20:44」のコードを整理してみるとこんな感じでしょうか。
興味があれば、【ステップ実行】して研究してみてください

    Sub 研究用()
        Dim ファイルパス As String
        Dim wbSaki As Workbook

        Stop 'ブレークポイントの代わり

        CreateObject("Wscript.shell").currentdirectory = "C:\Users\linki\Desktop\出庫リスト"
        ファイルパス = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")

        If ファイルパス <> "False" Then
            Set wbSaki = Workbooks.Open(fileName:=ファイルパス, ReadOnly:=True, UpdateLinks:=0)
        Else
            Exit Sub
        End If

        With wbSaki.Worksheets(1)
               MR = .Cells(.Rows.Count, 1).End(xlUp).Row
               MC = .Cells(8, .Columns.Count).End(xlToLeft).Column
               .Range("B7", .Cells(MR, MC)).Borders.LineStyle = True
        End With

        wbSaki.Save
        wbSaki.Close False
    End If

（もこな２） 2022/04/29(金) 10:17

2022/04/29(金) 09:29の質問者さんからの質問への回答が漏れていました。
ファイルを二度開く必要はありません。申し上げたとおりです。
ReadOnlyでは無い方で開いて下さい。
# 以前は、既に開いているものと同名のファイルを開くと警告が出たのですが、
# 最近のExcelでは動作が変わってきているようですね。

（γ） 2022/04/30(土) 08:45

コメント返信：

[ 一覧(最新更新順) ]

[[20220428180554]] 『別ファイルへ罫線を引くVBA』（梨） ページの最後に飛ぶ

[[20220428180554]]　『別ファイルへ罫線を引くVBA』（梨）　ページの最後に飛ぶ