Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

218 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【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

・ツリー全体表示


	【78089】Re:VBAで「リンク貼り付け」をしたい

マナ - 16/4/2(土) 10:43 -


	引用なし

	パスワード

▼かなさん：
毎回、シートを作り直しています。
シート名が不適切でエラーとなる場合もあるかもしれません。

Sub シート分け2()
　　Dim ws As Worksheet
　　Dim n As Long
　　 Dim h As Range
　　
　　With Worksheets("一覧表")
　　　　Application.DisplayAlerts = False
　　　　For Each ws In Worksheets
　　　　　　If ws.Name <> .Name Then ws.Delete
　　　　Next
　　　　Application.DisplayAlerts = True
　　　　
　　　　n = .Range("A1").CurrentRegion.Columns.Count
　　　　
　　　　'転記する
　　　　For Each h In .Range("H7:H" & .Range("H65536").End(xlUp).Row)
　　　　　　Set ws = Nothing
　　　　　　On Error Resume Next
　　　　　　Set ws = Worksheets(h.Value)
　　　　　　On Error GoTo 0
　　　　　　If ws Is Nothing Then
　　　　　　　　'支店名シートを新調する
　　　　　　　　Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
　　　　　　　　ws.Name = h.Value
　　　　　　　　.Rows(1).Resize(, n).Copy ws.Range("A3")
　　　　　　End If
　　　　　　ws.Range("H65536").End(xlUp).EntireRow.Resize(, n).Offset(1).Formula = _
　　　　　　　　"=" & h.EntireRow.Range("A1").Address(False, False, , True)
　　　　　　
　　　　Next
　　End With

End Sub

・ツリー全体表示


	【78088】Re:ブックの複製禁止

γ - 16/4/2(土) 8:34 -


	引用なし

	パスワード

解決したようで、何よりです。

>質問に対し
>　>水を差すわけではありませんが
>との的を外れた返信を頂き、
>　>訂正すべきところをお教えください。
>に対して
>　>私の見解は、コメントした通りですが
>　>なぜ、ByVal を指定したのですか？
>との(私にしてみれば)再び的外れと感じた返信を頂いたので
>言葉が過ぎた返信をいたしました。

少しも的外れではないと思いますよ。
>プロシージャの宣言が、イベントまたはプロシージャの定義と
>　　一致していません。
というエラーメッセージをキチンと読んでいれば、
なぜ、ByVal を指定したのですか？
という確認の意味を理解できるはずですね。

また、水を差すようですが、ということでの指摘も、
より広い範囲での留意点を述べられたもので、
これも参考として受け止めて欲しい有益な指摘だったと思います。
色々な視点からの指摘も活かせるような受け答えを勉強されると、
よろしいかと老婆心ながら思いました。
頑張ってくださいね。

・ツリー全体表示


	【78087】Re:複数図を選択して、グループ化するマ...

マナ - 16/4/1(金) 19:58 -


	引用なし

	パスワード

▼urupis さん：

activesheet.shapes.range(shapename).select

これで、どうなりますか？

・ツリー全体表示


	【78086】Re:VBAで「リンク貼り付け」をしたい

かな - 16/4/1(金) 19:08 -


	引用なし

	パスワード

ご回答、ありがとうございます。
質問内容を変えてしまって、大変すみませんでした。

考えていたところ、私が必要としていたのが「リンク貼り付け」だったので。

ご教授いただいたコードの雛形は、
「ActiveSheet.Paste Link:=True」なのかと思いますが、
これを今のコードの中でどこを変更すればよいのかが分かりません。

初心者ですみません。

・ツリー全体表示


	【78085】Re:VBAで「リンク貼り付け」をしたい

β - 16/4/1(金) 18:52 -


	引用なし

	パスワード

▼かなさん：

先ほどは、「値貼り付け」だったので、回答案をメモっていたら、取り消されて
「リンク貼り付け」になりましたね。

ある行をコピー　---> 別の行のA列を選択して　貼り付けで　リンク貼り付け。
これをマクロ記録すると、お望みのコード雛形が生成されますよ。

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

218 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free