Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
217 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
【78109】Re:アクティブ行の列を選択してセルの色...
お礼  HIRO  - 16/4/5(火) 13:27 -
引用なし
パスワード
   ▼β さん：
ありがとうございます！

迅速にご対応いただいたのに
確認が遅くなって非常に申し訳ありませんでした。

見事に成功しました！

シートに書かれているコードで、標準モジュールではなかったので
苦心していたところでした。
セル領域にシート修飾（ピリオド）をつけるという技に感動しました。
本当にありがとうございます。
そしてわかりやすい解説も付けていただき、感激しました。

まだまだ勉強が足りないな、と心から思いました。
今後とも何かあればご教示いただけますと幸甚です！

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

>▼HIRO さん：
>
>少しお先走ることになるかもしれませんが。
>
>もし、このコードが　Sheets(ShName)　ではないシートのシートモジュールに書かれていた場合は
>Range(Cells(gyou, 59),Cells(gyou,60)).Select　
>このコードで、1004エラー　RangeクラスのSelectメソッドが失敗しましたよいうエラーになります。
>
>Sheets(ShName).Activate
>
>これで、確実に Sheets(ShName) がアクティブシートになります。
>
>gyou = ActiveCell.Row
>
>ActiveCell はブックに１つしかありません。今アクティブになっているシートのアクティブになっているセルです。
>ですから、このコードも、確実に　Sheets(ShName)　のアクティブセルを参照します。
>
>問題はそのあと。
>
>Range(Cells(gyou, 59),Cells(gyou,60)).Select　
>
>セル領域に　どのシートなのかという情報を明示しない場合、
>・標準モジュールなら、今、アクティブになっているシート　とみなされます。
>　で、このコードは問題なくＯＫになるはずです。
>・シートモジュールの場合は、そのコードが書かれたシートということになります。
>　そのコードが書かれたシートが　Sheets(ShName)　ではなかった場合、
> 　Range(Cells(gyou, 59),Cells(gyou,60))　という領域は、今アクティブになっていないシートの領域になります。
>　アクティブではないシートの領域は　Select できません。なので、Select仕様とすると、
>　それはエクセルのルールに反している！！　と叱られます。
>
>対応策は２つ。
>
>１．このコードを標準モジュールに書く。
>２．シートモジュールであれば
>
>　　With Sheets(ShName)
>　　　　.Activate　　 'これはActiveCell取得のためやむなし
>　　　　gyou = ActiveCell.Row
>　　　　'セル領域にシート修飾（ピリオド）をつける　　　　
>　　　　.Range(.Cells(gyou, 59), .Cells(gyou, 60)).Interior.ColorIndex = 10
>　　End With
・ツリー全体表示
【78108】Re:アクティブ行の列を選択してセルの色...
発言  β  - 16/4/4(月) 20:47 -
引用なし
パスワード
   ▼HIRO さん：

少しお先走ることになるかもしれませんが。

もし、このコードが　Sheets(ShName)　ではないシートのシートモジュールに書かれていた場合は
Range(Cells(gyou, 59),Cells(gyou,60)).Select　
このコードで、1004エラー　RangeクラスのSelectメソッドが失敗しましたよいうエラーになります。

Sheets(ShName).Activate

これで、確実に Sheets(ShName) がアクティブシートになります。

gyou = ActiveCell.Row

ActiveCell はブックに１つしかありません。今アクティブになっているシートのアクティブになっているセルです。
ですから、このコードも、確実に　Sheets(ShName)　のアクティブセルを参照します。

問題はそのあと。

Range(Cells(gyou, 59),Cells(gyou,60)).Select　

セル領域に　どのシートなのかという情報を明示しない場合、
・標準モジュールなら、今、アクティブになっているシート　とみなされます。
　で、このコードは問題なくＯＫになるはずです。
・シートモジュールの場合は、そのコードが書かれたシートということになります。
　そのコードが書かれたシートが　Sheets(ShName)　ではなかった場合、
　Range(Cells(gyou, 59),Cells(gyou,60))　という領域は、今アクティブになっていないシートの領域になります。
　アクティブではないシートの領域は　Select できません。なので、Select仕様とすると、
　それはエクセルのルールに反している！！　と叱られます。

対応策は２つ。

１．このコードを標準モジュールに書く。
２．シートモジュールであれば

　　With Sheets(ShName)
　　　　.Activate　　 'これはActiveCell取得のためやむなし
　　　　gyou = ActiveCell.Row
　　　　'セル領域にシート修飾（ピリオド）をつける　　　　
　　　　.Range(.Cells(gyou, 59), .Cells(gyou, 60)).Interior.ColorIndex = 10
　　End With
・ツリー全体表示
【78107】Re:アクティブ行の列を選択してセルの色...
回答  マリオ  - 16/4/4(月) 20:44 -
引用なし
パスワード
   これだと、どうでしょうか？エラーになりますか？

　　Dim sh As Worksheet
　　Set sh=Sheets(ShName)
　　sh.Activate
　　Dim gyou As Long
　　gyou = ActiveCell.Row
　　
　　'アクティブシート名を確認
　　Debug.Print Activeheet.Name
　　
　　'念のためもう一度、
　　sh.Activate
　　
　　'★Cellsの前もシートを指定する
　　sh.Range(sh.Cells(gyou, 59),sh.Cells(gyou,60)).Select
　　
　　Selection.Interior.ColorIndex = 10
・ツリー全体表示
【78106】Re:アクティブ行の列を選択してセルの色...
発言  β  - 16/4/4(月) 19:56 -
引用なし
パスワード
   ▼HIRO さん：

もう１つ。
このコードはどこに書かれていますか？

標準モジュールですか？
シートモジュールですか？
・ツリー全体表示
【78105】Re:アクティブ行の列を選択してセルの色...
発言  β  - 16/4/4(月) 19:21 -
引用なし
パスワード
   ▼HIRO さん：

この処理を行うためにシートをActivateしたり、セルをSelectしたりしないでも
できますし、そうしないのが基本ですけど、それはそれとして。

エラー　のエラー番号とメッセージは、どういうものでしたか？
・ツリー全体表示
【78104】Re:VBAで複数のシートのコピーをしたい
発言  β  - 16/4/4(月) 19:16 -
引用なし
パスワード
   ▼かな さん：

もう1例。

Sub Test2()
　　Dim nbk As Workbook
　　Dim sh As Worksheet
　　
　　Application.ScreenUpdating = False
　　
　　ThisWorkbook.Worksheets.Copy
　　Set nbk = ActiveWorkbook
　　Application.DisplayAlerts = False
　　nbk.Sheets(1).Delete
　　Application.DisplayAlerts = True
　　
　　For Each sh In nbk.Worksheets
　　　　sh.Name = sh.Name & "(AAA)"
　　Next
　　
End Sub
・ツリー全体表示
【78103】Re:VBAで複数のシートのコピーをしたい
発言  β  - 16/4/4(月) 19:11 -
引用なし
パスワード
   ▼かな さん：

いろんな方法があります。
以下は、一例です。
ブックは新規で作成します。
（既存のブックに追加するということもできますが）

Sub Test()
　　Dim done As Boolean
　　Dim nbk As Workbook
　　Dim sh As Worksheet
　　
　　Application.ScreenUpdating = False
　　
　　For Each sh In ThisWorkbook.Worksheets
　　　　If sh.Index > 1 Then
　　　　　　If Not done Then
　　　　　　　　sh.Copy
　　　　　　　　Set nbk = ActiveWorkbook
　　　　　　　　done = True
　　　　　　Else
　　　　　　　　sh.Copy after:=nbk.Worksheets(nbk.Worksheets.Count)
　　　　　　End If
　　　　　　
　　　　　　DoEvents　　'念のため
　　　　　　
　　　　　　nbk.Worksheets(nbk.Worksheets.Count).Name = sh.Name & "(AAA)"
　　　　End If
　　Next
　　
End Sub
・ツリー全体表示
【78102】アクティブ行の列を選択してセルの色を変...
質問  HIRO  - 16/4/4(月) 17:54 -
引用なし
パスワード
   はじめまして。VBAで苦戦しており、質問させていただきます。

売上集計シートの行を１つ選択（任意）して、
別の帳票シートに値をコピーし、帳票を印刷するマクロを設定しています。
帳票に記載する内容が正しければそのまま印刷し、
売上集計シートの行・59および60列目のセルの色を変更します。
これは実行できました。

が、帳票に記載する内容が間違っている場合に、いったん帳票シートで修正をかけ、
出力ボタンで印刷するのですが、
その際に、元の売上集計シートの行・59および60列目のセルの色が変更できません。

印刷が成功した後に以下のようなコードを付けていますが

Sheets(ShName).Activate
　　　Dim gyou As Long
　　　gyou = ActiveCell.Row
　　　　
　　　Range(Cells(gyou, 59),Cells(gyou,60)).Select　'エラー'
　　　Selection.Interior.ColorIndex = 10

どうしてもエラーが発生し、思うように動作してくれません。
gyou = ActiveCell.Rowは正しく取得できているのですが・・・

お知恵を拝借できると助かります。
どうぞよろしくお願いいたします。
・ツリー全体表示
【78101】Re:別のブックに貼り付け
お礼  kan  - 16/4/4(月) 17:51 -
引用なし
パスワード
   ▼マナ さん：
>こういうことみたいです。
>
>ht tp://support.microsoft.com/kb/2851316/ja

情報有り難うございます。
一度いろいろ試してみたいと思います。
また、結果が出ましたらお知らせ致します。
・ツリー全体表示
【78100】VBAで複数のシートのコピーをしたい
質問  かな  - 16/4/4(月) 11:08 -
引用なし
パスワード
   VBAで複数シートのコピーをしたいのですが自力では難しいので質問です。
お助けいただければ幸いです。

条件は下記です。

・シートは複数あるが数は決まっていない
・コピー元のシートの名前はいつも同じではない
・一番左のシートはコピーしない
・できればシート名を「コピー元のシート名(AAA)」としたい

この条件でVBAはどのようになるでしょうか？
よろしくお願いします。
・ツリー全体表示
【78099】Re:VBAで「リンク貼り付け」をしたい
お礼  かな  - 16/4/4(月) 10:37 -
引用なし
パスワード
   βさん、マナさん、ご回答ありがとうございます。

問題を解決することが出来ました。
非常に助かりました。
・ツリー全体表示
【78098】Re:別のブックに貼り付け
発言  マナ  - 16/4/3(日) 22:13 -
引用なし
パスワード
   ▼β さん：
以前、こんな感じの質問がありました。
シートにボタンを置いて、Macro2を登録して実行。

Sub Macro2()
　　UF1.Show
End Sub

Private Sub OK_Click()
　　Worksheets.Add
　　Cells(6, 7).Value = TB1
　　Unload UF1
End Sub

やはり2010はOKで2013で異常？
追加したシートでスクロールできない。終了できない。
そのときも、別シートを選択してから、戻ると正常になりました。
・ツリー全体表示
【78097】Re:別のブックに貼り付け
発言  β  - 16/4/3(日) 21:27 -
引用なし
パスワード
   ▼マナ さん：

情報ありがとうございます。
やはり、MDI,SDIがらみでしたか。
Msから２つの回避策が提示されていましたが、私が↑でコメントした方法も
（もし、別ブックが、開かれていた場合には）ありですかね。
・ツリー全体表示
【78096】Re:別のブックに貼り付け
発言  マナ  - 16/4/3(日) 20:56 -
引用なし
パスワード
   こういうことみたいです。

ht tp://support.microsoft.com/kb/2851316/ja
・ツリー全体表示
【78095】Re:別のブックに貼り付け
発言  β  - 16/4/3(日) 18:55 -
引用なし
パスワード
   ▼kan さん：

回答ではなく、こちらの検証結果を報告します。

１．まず、TB1を「適当な値」に置き換えるとＯＫだったとコメントしましたが
　　勘違いで、やはりＮＧでした。
２．2.xlsm のリボンは固まっているわけですが、この状態で 1.xlsm を選択し
　　あらためて 2.xlsm を選択するとリボンの塊は解除されています。
３．現象としてはモーダル表示されたユーザーフォームがUNLOAD されて
　　シート（セル群）は、モーダル状態が解除されていますが、リボン部分のみ
　　モーダルの影響が残っているような状態ですね。
４．このコードを xl2010環境で実行すると全く問題はありませんね。

★推測ですが、バグだと思います。
　2013で SDIインターフェースに変わった結果、それまでの MDIインターフェース時は
　なんの問題もなく動いていたものがＮＧになるというケースは、他のケースでも
　発生しています。これも、それがらみなのかなと思います。
・ツリー全体表示
【78094】Re:別のブックに貼り付け
発言  β  - 16/4/3(日) 18:04 -
引用なし
パスワード
   ▼kan さん：

TB1 って、テキストボックスだったんですね。
失礼しました。

こちらの2013 でも似たような状況再現しました。
ちょっと調べてみます。
・ツリー全体表示
【78093】Re:別のブックに貼り付け
発言  β  - 16/4/3(日) 18:02 -
引用なし
パスワード
   ▼kan さん：

当方のxl2013 でアップされたコードを、そのまんま使い（ただし TB1 は　適当な値に変えましたが）
実行したところ、macro1,macro2-->ユーザーフォームのクリック　いずれも
全く問題なく動いて結果がでました。
・ツリー全体表示
【78092】Re:別のブックに貼り付け
発言  β  - 16/4/3(日) 17:59 -
引用なし
パスワード
   ▼kan さん：

回答ではありません。

>　　Cells(6, 7).Value = TB1

TB1 って何でしょうか？
・ツリー全体表示
【78091】別のブックに貼り付け
質問  kan  - 16/4/2(土) 16:44 -
引用なし
パスワード
   2010までのEXCELでは問題なく動くのですが、2013以降のEXCELでは、ユーザーフォームを使って、別のブックを開きテキストボックスに入力して開くと
上部リボンがフリーズしたり、元のブックが表示したまま、新たに開いたブックが表示できなくなります。何か良い解決方法が有るかお教え下さい。
直接起動させるコードは下記になります。

元ブック　　　1.xlsm
開くブック　　2.xlsm

Sub Macro1()
　　Workbooks.Open Filename:="D:\2.xlsm"
　　Range("H6").Select
　　ActiveCell.FormulaR1C1 = "win10"
End Sub
これでは問題ないのですが、下記の様にユーザーフォームを利用すると問題が生じます。

Sub Macro2()
　　UF1.Show
End Sub

Private Sub OK_Click()
　　Workbooks.Open Filename:="D:\2.xlsm"　
　　Cells(6, 7).Value = TB1
　　Unload UF1
End Sub

以上　よろしくお願いいたします。
・ツリー全体表示
【78090】Re:VBAで「リンク貼り付け」をしたい
発言  β  - 16/4/2(土) 11:19 -
引用なし
パスワード
   ▼かな さん：

>これを今のコードの中でどこを変更すればよいのかが分かりません。

一例です。
操作のリンク貼り付けも同様になりますが参照セルが空白の場合は 0 になります。
（空白なら空白　という式にすることもできますが、とりあえず）

Sub シート分け3()
　　Const LISTNAME As String = "一覧表"
　　Dim h As Range
　　Dim cols As Long
　　Dim tSh As Worksheet
　　
　　With Sheets(LISTNAME)
　　　　cols = .Range("A1", .UsedRange).Columns.Count
　　　　For Each h In .Range("H7", .Range("H" & .Rows.Count).End(xlUp))
　　　　　　If Not IsObject(Evaluate("'" & h.Value & "'!A1")) Then　　'シート有無チェック
　　　　　　　　Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = h.Value
　　　　　　　　.Range("1:1").Copy Range("A3")
　　　　　　End If
　　　　　　With Sheets(h.Value)
　　　　　　　　.Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(, cols).FormulaR1C1 = "='" & LISTNAME & "'!R" & h.Row & "C"
　　　　　　End With
　　　　Next
　　End With

End Sub
・ツリー全体表示
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
217 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free