[[20100330104626]]　『シートをコピーした後、コピーにだけ見出しに色を』（kn）　ページの最後に飛ぶ

『シートをコピーした後、コピーにだけ見出しに色を付ける』（kn）

 以前、こちらでマクロを教えて頂いたときは大変助かりました。有り難うございます。
 今回は、その前回のマクロに「シート見出しの色を付ける」という指示を追加したいのです。

 Sub ボタン1_Click()
   Dim vntSheetName As Variant
   Dim WS1 As Worksheet
   Dim WS2 As Worksheet
   Dim lngRow As Long
   vntSheetName = ""
   Do While vntSheetName = ""
      vntSheetName = Application.InputBox("追加シート名を入力して下さい。", "シート追加", Type:=2)
      If VarType(vntSheetName) = vbBoolean Then
         MsgBox "キャンセルしました"
         Exit Do
      Else
         If wsexist(ThisWorkbook, vntSheetName) Then
            MsgBox vntSheetName & "　：　このシート名は既に存在します。違うシート名を指定してください"
            vntSheetName = ""
         End If
      End If
   Loop
   If Not VarType(vntSheetName) = vbBoolean Then
      Sheets("週報").Copy After:=Worksheets(Sheets.Count)
      Set WS1 = Worksheets("in")
      Set WS2 = ActiveSheet
      WS2.Name = vntSheetName
      lngRow = WS1.Range("A" & WS1.Rows.Count).End(xlUp).Offset().Row
      WS1.Cells(lngRow, 17).Value = vntSheetName
      WS1.Activate

   End If

  Dim ws As Worksheet, wsName() As String, i As Long
  Columns("Q").ClearContents
  ReDim wsName(1 To Worksheets.Count - 2, 1 To 1)
  For Each ws In Worksheets
    If ws.Name <> "in" And ws.Name <> "週報" And ws.Name <> "手書き用" Then
      i = i + 1
      wsName(i, 1) = ws.Name
    End If
  Next ws
  Range("Q1").Resize(UBound(wsName)).Value = wsName
  End Sub
 '========================================================================
 Function wsexist(ByVal bk As Workbook, ByVal shtnm As String) As Boolean
    'wsexist true   指定のシート名は存在する
    '         false 指定のシート名は存在しない
    On Error Resume Next
    Err.Clear
    Dim wk As Object
    Set wk = bk.Sheets(shtnm)
    wsexist = Not CBool(Err.Number)
    On Error GoTo 0
 End Function

 ※"in"　　　　=　データ用シート
 　"週報"　　　=　コピーする元のシート
 　"手書き用"　=　マクロには関わってきません。

 現在、ボタンをクリックするとシート名を指定して"週報"をコピー、
 上記３つを除く全てのシート名を取得し、"in"に表示させるようになっています。

 そこで、コピーしたほうのシートのみにシート見出しの色を統一で付けられる様にしたいのですが、如何せん初心者ゆえ、
 どんなマクロなら良いのか、何処に組み込めばいいのかさっぱり見当がつきません。

 宜しければアドバイスお願い致します。

 OSはXP、バージョンは2007です。

 何はさておき、まず「シート見出しに色を付ける」と言うコードが必要です。
 これはマクロの記録で得られると思いますが、記録してみましたか？

 また、お伺いしてみますが
      Set WS2 = ActiveSheet
      WS2.Name = vntSheetName
 この２行がどんな指示を出しているか
 説明出来ますか？

 (HANA)

 HANA様、コメント有り難うございます。

 通常、例として
 Sub Sample09()
    Worksheets("Sheet1").Tab.ColorIndex = 3
 End Sub
 このようなマクロになりますよね。それは調べることが出来たのですが、これを何処にどう入れれば良いのかが分かりませんでした。

      Set WS2 = ActiveSheet
      WS2.Name = vntSheetName
 この２つについてですが、一番最初に組んだときにこの掲示板にあるものをコピーして作成したので、
 よく分かりません。
 申し訳ないです。

 えっと。。。そんなに難しく考えず

 Set WS2 = ActiveSheet
 　→アクティブシート をWS2にセットする・・・のかな？

 WS2.Name = vntSheetName
 　→WS2の名前を vntSheetName にする・・・のかな？

 って読めませんか？

 「vntSheetName」は、上の方で
 vntSheetName = Application.InputBox("追加シート名を入力して下さい。", "シート追加", Type:=2)
 追加シート名を入力しましたね？

 すると、WS2にはアクティブシートがセットされているのだから
 アクティブシートの名前を InputBox に入力した名前にする・・・のかな？

 と思いませんか？

 でも、その通りに動いていますよね？

 シートタブの色を変えたいのは、Worksheets("Sheet1")ではなく
 どのシートだったら良いのですか？

 まずはコピペでも動くコードを作るのが良いとは思いますが
 動くコードが出来たら、内容を読んで行かないと
 いつまでたっても分かるようにはならないと思いますよ？

 勿論、呪文のように覚えておけばよい部分もありますが
 Set とか Name とか InputBox とか ActiveSheet とか・・・・
 そんなになじみの薄い単語ではないと思います。

 (HANA)

 HANA様の仰るとおりに動いておりました。

 >シートタブの色を変えたいのは、Worksheets("Sheet1")ではなく
 >どのシートだったら良いのですか？
　
 それが、その時その時でつける名前が違うのでどうすればいいのかと悩んでおりまして。。
 変数を指定すれば良いのでしょうか？？

 HANA様のお手を煩わせてしまい申し訳ないのですが、マクロを組んだりしても内容がなかなか理解できずにいつも苦労しております。

 えっと。。。。
 コピーしたシートの名前を変える時だって
 コピー後のシートの名前を指定して変更してませんよね？

 Sheets("週報をコピーして出来たシート名を指定して").Name = vntSheetName
 ってしてませんよ？

 何で指定せずに済んでるかって言うと

      Sheets("週報").Copy After:=Worksheets(Sheets.Count)
 週報シートをコピーしたら、コピー後のシートがアクティブに成ってますね？
      Set WS2 = ActiveSheet
 アクティブシートをWS2にセットしてます。アクティブシート＝コピー後のシートです。
      WS2.Name = vntSheetName
 WS2＝アクティブシート＝コピー後のシート・・・の名前を変更

 しているので、週報シートをコピーした時のシート名が
 週報(1) でも 週報(2) でも 週報(3) でも何になったとしても
 コピーしたシートの名前を vntSheetName に変更出来ます。

 コピーしたシートのタブの色を変える時も
 同じようにすればシートの名前を指定しなくても良いですよね？

 WS2＝アクティブシート＝コピー後のシート・・・のタブの色を変更

 ＞変数を指定すれば良いのでしょうか？？
 どうしてもシート名を指定したいなら
 「vntSheetName」にシート名は入っていると思いますので
 そのまま使用すればよいと思います。

 それから、シートは
      Sheets("週報").Copy After:=Worksheets(Sheets.Count)
                          After ＝ 後　Worksheets(Sheets.Count) ＝ 一番最後のシート の
 一番最後のシートの後にコピーされているので
 　その時点での一番最後のシート ＝ コピーしたシート
 と言う指定でも良いですね。

 あまり難しく考えなくて良いと思いますが。。。
 たくさんエラーも出してみて下さい。
 エラーが出たコードをたくさん載せて下さい。
 次の書き込み以上は、引っ張ろうとは思いませんので。

 (HANA)

 HANA様、アドバイス有り難う御座います。

 一度「シートコピー→見出し色を付ける」というマクロを記録させ、
 HANA様の説明を読みながら考えてみました。

 Sub ボタン1_Click()
   Dim vntSheetName As Variant
   Dim WS1 As Worksheet
   Dim WS2 As Worksheet
   Dim lngRow As Long
   vntSheetName = ""
   Do While vntSheetName = ""
      vntSheetName = Application.InputBox("追加シート名を入力して下さい。", "シート追加", Type:=2)
      If VarType(vntSheetName) = vbBoolean Then
         MsgBox "キャンセルしました"
         Exit Do
      Else
         If wsexist(ThisWorkbook, vntSheetName) Then
            MsgBox vntSheetName & "　：　このシート名は既に存在します。違うシート名を指定してください"
            vntSheetName = ""
         End If
      End If
   Loop
   If Not VarType(vntSheetName) = vbBoolean Then
      Sheets("週報").Copy After:=Worksheets(Sheets.Count)
      Set WS1 = Worksheets("in")
      Set WS2 = ActiveSheet
      WS2.Name = vntSheetName
      lngRow = WS1.Range("A" & WS1.Rows.Count).End(xlUp).Offset().Row
      WS1.Cells(lngRow, 17).Value = vntSheetName
      WS1.Activate

   End If

   With Worksheets(Sheets.Count).Tab
     .Color = 255

     End With

  Dim ws As Worksheet, wsName() As String, i As Long
  Columns("Q").ClearContents
  ReDim wsName(1 To Worksheets.Count - 2, 1 To 1)
  For Each ws In Worksheets
    If ws.Name <> "in" And ws.Name <> "週報" And ws.Name <> "手書き用" Then
      i = i + 1
      wsName(i, 1) = ws.Name
    End If
  Next ws
  Range("Q1").Resize(UBound(wsName)).Value = wsName
  End Sub
 '========================================================================
 Function wsexist(ByVal bk As Workbook, ByVal shtnm As String) As Boolean
    'wsexist true   指定のシート名は存在する
    '         false 指定のシート名は存在しない
    On Error Resume Next
    Err.Clear
    Dim wk As Object
    Set wk = bk.Sheets(shtnm)
    wsexist = Not CBool(Err.Number)
    On Error GoTo 0
 End Function

 で、色を指定する事が出来ました（これが正しいのかは分かりませんが…）
 大変助かりました。ありがとうございます。

 （kn）

 出来ましたか、良かったです。

 因みに
   With Worksheets(Sheets.Count).Tab
     .Color = 255
   End With
 3行で書いてありますが、With でまとめる必要は無さそうですよ？
   Worksheets(Sheets.Count).Tab.Color = 255

 シート名が変数「vntSheetName」に入ったままに成っているので
   Worksheets(vntSheetName).Tab.Color = 255
 でも良いと思います。

 でも、せっかく
      Set WS2 = ActiveSheet
      WS2.Name = vntSheetName
 と言う記述が有るので、このすぐ下に
      WS2.Tab.Color = 255
 でも良かったのではないかと思いますが。。。どうでしょう？

 それから、前の話しの続きだと思いますが
      lngRow = WS1.Range("A" & WS1.Rows.Count).End(xlUp).Offset().Row
      WS1.Cells(lngRow, 17).Value = vntSheetName
 この２行は要らないんじゃないかと思います。

 で、WS1.Activate の後に
   Call sheetsname
 とすると、↑と重複する部分のコードは不要に成ります。
[[20100301163618]]　『シートのコピー＆削除とシート名の取得』（ｋｎ）

 ・・・と思ったのですが、最後にアクティブにするのは
 コピーしたシートですか・・・？

 (HANA)

 お返事が遅くなってしまい大変申し訳ございません。

 >因みに
 >  With Worksheets(Sheets.Count).Tab
 >    .Color = 255
 >  End With
 >3行で書いてありますが、With でまとめる必要は無さそうですよ？
 >  Worksheets(Sheets.Count).Tab.Color = 255
 >
 >シート名が変数「vntSheetName」に入ったままに成っているので
 >  Worksheets(vntSheetName).Tab.Color = 255
 >でも良いと思います。

 これを試してみたのですが、エラーが出てしまいました。
 withでまとめる必要がないってことはそのまま書いてイイって事ではないんでしょうか？
 私の読解力の問題でしょうか…

 >それから、前の話しの続きだと思いますが
 >     lngRow = WS1.Range("A" & WS1.Rows.Count).End(xlUp).Offset().Row
 >     WS1.Cells(lngRow, 17).Value = vntSheetName
 >この２行は要らないんじゃないかと思います。
 >
 >で、WS1.Activate の後に
 >  Call sheetsname
 >とすると、↑と重複する部分のコードは不要に成ります。

 この部分は仰るとおり、変更しても何も問題ありませんでした。

 あと、最後にアクティブになるのは"in"のシートです。

 （kn）

 私の記述の仕方が悪かったようです。

 Worksheets(Sheets.Count).Tab.Color = 255

 でいけました。

 HANA様のおかげで、マクロの考え方も前より分かってきたような気がします。
 このデータのマクロもかなりスッキリしたコードになりました！
 本当に有り難う御座いました。

 （kn）

 現在コードのシートをコピーする部分の処理は
   If Not VarType(vntSheetName) = vbBoolean Then
      Sheets("週報").Copy After:=Worksheets(Sheets.Count)
      Set WS1 = Worksheets("in")
      Set WS2 = ActiveSheet
      WS2.Name = vntSheetName
      WS2.Tab.Color = 255
      WS1.Activate
      Call sheetsname
   End If
 となっていますか？

 その場合、WS1 は Set した後一回しか使ってないですよね？
 ですので、Set せずに直接
      Worksheets("in").Activate
 としても良いのではないかと思います。

 また、WS2もSet してありますが
      With ActiveSheet
           .Name = vntSheetName
           .Tab.Color = 255
      End With
 の様にしておけば、SW2の Set も不要になると思います。

 (HANA)

 アドバイス有り難う御座います。

  Sub ボタン1_Click()
    Dim vntSheetName As Variant
    Dim lngRow As Long
    vntSheetName = ""
    Do While vntSheetName = ""
       vntSheetName = Application.InputBox("追加シート名を入力して下さい。", "シート追加",Type:=2)
       If VarType(vntSheetName) = vbBoolean Then
          MsgBox "キャンセルしました"
          Exit Do
       Else
          If wsexist(ThisWorkbook, vntSheetName) Then
             MsgBox vntSheetName & "　：　このシート名は既に存在します。違うシート名を指定してください"
             vntSheetName = ""
          End If
       End If
    Loop
     If Not VarType(vntSheetName) = vbBoolean Then
       Sheets("週報").Copy After:=Worksheets(Sheets.Count)
       With ActiveSheet
            .Name = vntSheetName
            .Tab.Color = 5287936
       End With
       Worksheets("in").Activate
       Call sheetsname
     End If

   End Sub

 というようにしておけばいいでしょうか？

 ＞というようにしておけばいいでしょうか？
 と言われると、ちょっとドキドキしちゃいますが
 私ならその様にしておきます。

 後で何度か出てくるなら Set した方が良い場合も有ると思います。
 また、Set した方がご自身で分かりやすいと思えば Set すれば良いと思います。

 今回の変更は、動きに関係する事ではなく
 物語に関係する事なので。

 例えば、Set するかしないかは
 　昔々ある所に、おじいさんとおばあさんが住んでいました。
 　おじいさんは山へ芝刈りに、おばあさんは川へ洗濯に行きました。
 と言うお話と
 　おじいさんを「人物１」おばあさんを「人物２」と表す事にします。
 　昔々ある所に、人物１と人物２が住んでいました。
 　人物１は山へ芝刈りに、人物２は川へ洗濯に行きました。
 と言うお話の違いの様な感じです。

 内容はどちらも同じです。
 もしも、登場人物がおじいさんとおばあさんではなく
 キツネとタヌキに変更になった場合、
 最初のお話では４箇所変更が必要ですが
 次のお話では２箇所変更するだけで済みますね。

 「人物１」と「人物２」を後で一度しか使わないなら
 Setしてもしなくても、２箇所の変更は必要なので
 数の点から見るとどちらでも同じです。

 ただ、この場合も　この二つが、長いコードの中間と下の方に出てくる様なもので
 それを探し出して変更するのが面倒だと思うなら
 コードの最初の方にまとめて　Set しておいても良いと思います。
 後で追加の処理が有りそうだと思うのなら
 現在不要でも先を見越して Set しておいても良いと思います。

 ですが、使う前に「○○と表す事にします」と言う一文が必要ですし
 　　　　○○で何を表す事にしたのか覚えておく必要が有ります。

 ただ漫然と、参考にした元のコードがこうなっていたからその様にしていたコード　と
 いくつかの方法の内どの方法でやろうかしっかり考えて作ったコード　とでは
 そのコードに変更が必要に成った時に得られる物は違ってくると思います。

 動くコードが出来たら、もう一歩踏み込んで頂くと良いと思います。
 すると、他の人のコードを見る目（自分の参考に成りそうなコードを探す目）も
 変わってくると思います。

 (HANA)

 HANA様、とても分かり易い解説ありがとうございます。
 数ヶ月前に見様見真似でマクロをいじりはじめた私にですので、
 今社内で使っているコードも半分理解、半分暗号といった具合でデバックするような事にならない限り
 コードを見たりすることもありませんでした。

 今回、初めて１からマクロを組んで、HANA様はじめ色んな方からアドバイスを頂き
 少しずつですが理解できるようになってきた様に思います。

 これからももっと実用的なものが組めるよう勉強していきたいと思います。

 本当にありがとうございました。

 （kn）

コメント返信：

[ 一覧(最新更新順) ]

[[20100330104626]] 『シートをコピーした後、コピーにだけ見出しに色を』（kn） ページの最後に飛ぶ

[[20100330104626]]　『シートをコピーした後、コピーにだけ見出しに色を』（kn）　ページの最後に飛ぶ