Excel VBA質問箱 IV

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

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


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

45 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【81583】Re:Msgboxを表示中に、別のExcelブックを...

OK - 20/12/29(火) 11:56 -


	引用なし

	パスワード

ユーザーフォームなどで作ったMsgBoxのようなもの
ではなくMsgBoxに拘る理由は何ですか？

基本的にMsgBox表示中は他の捜査は出来ない
ことは常識なので、そこを敢えてやりたい理由を教え
てください。

・ツリー全体表示


	【81582】Msgboxを表示中に、別のExcelブックを操作

稲垣 - 20/12/26(土) 16:35 -


	引用なし

	パスワード

お世話になっております。
当方、Office Professional Plus 2016を使用しています。

題名通りの質問なのですが、
VBAでMsgboxを表示中に、別のExcelブックを操作することは可能でしょうか。
操作と申しますのは、起動、セル内容の編集、VBAの実行などを指します。

もし可能な場合、その方法をご教授頂けましたら幸いです。
お手数をお掛けしますが、宜しくお願い致します。

・ツリー全体表示


	【81581】Re:任意の行数で改ページし印刷する

あおこ - 20/12/21(月) 16:34 -


	引用なし

	パスワード

▼［名前なし］さん：
>各シートが用紙に入る範囲であれば
>
>４範囲を２ｘ２に並べたら
>
>　　ActiveSheet.PageSetup.Zoom = 50
>　　ActiveSheet.PrintPreview
>
>は、できないだろうか？

返信ありがとうございます。

現在の表の大きさだと、横２つで用紙横１ページに収まるように印刷すると、縦の長さにもよりますが、大体70％程度になり、50％だと小さく表示されます。

ご指摘を理解できていなかったらすみません・・。

元の表が横１ページにきっちり収まるように作れば、２×２で50％にすればよいということであってますか？

・ツリー全体表示


	【81580】Re:任意の行数で改ページし印刷する

［名前なし］ - 20/12/20(日) 11:21 -


	引用なし

	パスワード

各シートが用紙に入る範囲であれば

４範囲を２ｘ２に並べたら

　　ActiveSheet.PageSetup.Zoom = 50
　　ActiveSheet.PrintPreview

は、できないだろうか？

・ツリー全体表示


	【81579】Re:セルを分割し別ブックに保存する

［名前なし］ - 20/12/20(日) 11:13 -


	引用なし

	パスワード

Sub tes()

Dim objFs As Object
Dim InPath As String, OutPath As String
Dim InFs As Variant, InBook As Workbook, InSh As Worksheet
Dim OutBook As Workbook, OutSh As Worksheet, OutFname As String
Dim Flag As Boolean, Cnt As Integer
Dim Dic As Object, DicVari As Variant
Dim FnamEx　As String, FsEx As String, DirFn As String
　　　　
　　　　
''''
InPath = "D:\IN"
OutPath = "D:\OUT"
FnamEx = ".xlsx"

''''
InPath = InPath & "\"
OutPath = OutPath & "\"

''''

Dim app As New Excel.Application
app.Visible = False
With app
　　'
　　If Dir(OutPath, vbDirectory) = "" Then
　　　　MkDir OutPath
　　End If
　　'
　　Set Dic = CreateObject("Scripting.Dictionary")

　　Set objFs = CreateObject("Scripting.FileSystemObject")
　　For Each InFs In objFs.GetFolder(InPath).Files
　　　　FsEx = "." & LCase(objFs.GetExtensionName(InFs.Name))
　　　　If FsEx = FnamEx Then
　　　　　　Debug.Print InFs.Name
　　　　　　Set InBook = .Workbooks.Open(InPath & InFs.Name)
　　　　　　
　　　　　　For Each InSh In InBook.Sheets
　　　　　　　　OutFname = InSh.Range("D4").Text & FnamEx
　　　　　　　　DirFn = OutPath & OutFname
　　　　　　　　If Dic.Exists(OutFname) = False Then
　　　　　　　　　　Dic.Add OutFname, 0
　　　　　　　　　　If Dir(DirFn) <> "" Then
　　　　　　　　　　　　Set OutBook = .Workbooks.Open(DirFn)
　　　　　　　　　　　　
　　　　　　　　　　Else
　　　　　　　　　　　　Set OutBook = .Workbooks.Add
　　　　　　　　　　　　OutBook.SaveAs (DirFn)
　　　　　　　　　　　
　　　　　　　　　　End If
　　　　　　　　Else
　　　　　　　　　　'Dic登録済み。Book開いている。
　　　　　　　　　　Set OutBook = .Workbooks(OutFname)
　　　　　　　　　
　　　　　　　　End If
　　　　　　　　'シートコピー
　　　　　　　　Cnt = OutBook.Sheets.Count
　　　　　　　　InSh.Copy After:=OutBook.Sheets(Cnt)
　　　　　　　　'シートプロテクト
　　　　　　　　Cnt = Cnt + 1
　　　　　　　　OutBook.Sheets(Cnt).Protect
　　　　　　　　
　　　　　　　　Set InSh = Nothing
　　　　　　　　Set OutBook = Nothing
　　　　　　Next
　　　　　　
　　　　　　InBook.Close False
　　　　　　Set InBook = Nothing
　　　　End If
　　Next
'開いたOutBookを閉じる
　　For Each DicVari In Dic
　　　　OutFname = DicVari
　　　　.Workbooks(OutFname).Save
　　　　.Workbooks(OutFname).Close
　　Next
End With

app.Quit
Set app = Nothing

End Sub

・ツリー全体表示


	【81578】任意の行数で改ページし印刷する

あおこ - 20/12/17(木) 15:06 -


	引用なし

	パスワード

こんにちは
いつも参考にさせていただいています。

複数のシートの表を１枚のシートにまとめて印刷する　という作業をVBAで行っています。
作業するファイルごとに表の行数は違っており（同一ファイルのシートの表の行数は同じ）、任意の行数から成る表を1枚のシートに横2×縦（可変個数）貼り付けています。
これを印刷のときには、表４つ分ずつ印刷したいと思っています。

↓イメージ

□□
□□
--改ページ
□□
□□
--改ページ
□□

改ページを先に入れて、その後印刷設定（横１×縦指定ページ）を入れると点線の改ページ（自動）が出てきて、うまく印刷できないため、何か方法はないかとネットで調べたところ、

改ページしたい行数insatugyoとシートの最終行を元に縦のページ数pを算定して、横１×縦pページで印刷するよう指定し（ここで改ページが自動で挿入されるようです）、その後、自動で入った改ページと印刷したい枚数に必要な改ページ数との過不足を調整します。必要数改ページが入ったら改ページの位置を指定の位置に移動させます。

という処理方法を見つけましたので、そのコードを元に下記のとおり記載しました。

実行したところ、（５）の改行の位置設定の箇所でエラーとなります。

例えば90行ごとに5ページ印刷する場合、（５）に処理が進んだ状態では、4つの改行が挿入されていますが、
１ループ目の
　sh_B1.HPageBreaks(4)..Location =　sh_B1.Range("A361")
を過ぎた後、
印刷設定の横１×縦５ページがいずれも「自動」に変更になり、改ページの数が上記で入れた改ページの１つのみになるため、次のループでsh_B1.HPageBreaks(3)が存在しなくなり、エラーとなります。
※なお、今テストで作っているシートでは、改ページの過不足は発生していないため（１）からすぐ（５）に処理がうつっている状況です。

エラーの出ない方法もしくは、別の方法で、希望の行数ごとに1枚に収めて印刷
する方法がありますでしょうか。
考え方のヒントでもけっこうですので、ご教示くださると幸いです。

よろしくお願いいたします。

===================================================================
With sh_B1
　lRow = .Range("B" & Rows.Count).End(xlUp).Row '最終行を求める
　p = lRow \ insatugyo + 1 '印刷ページ数を求める
End With
　　
sh_B1.ResetAllPageBreaks '改ページリセット
　With sh_B1.PageSetup
　　.Zoom = False
　　.FitToPagesWide = 1　'横１ページに収める
　　.FitToPagesTall = p　'縦を指定のページ数に収める
　End With
　　
ActiveWindow.View = xlPageBreakPreview '改ページプレビュー
　　
'印刷したいエリアごとに名前をつける Area1、Area2、・・・
With sh_B1
　 For i = 1 To p
　 Dim k As Integer 'エリア開始行を格納する変数
　　 k = (i - 1) * insatugyo + 1
　　.Range("A" & k & ":M" & i * 2 * (chk + 1)).Name = "Area" & i
　 Next i
End With
　　　　
Dim n As Integer
n = sh_B1.HPageBreaks.Count　'……(1)'HPageBreaksの数を変数 n に代入。
　If n > p - 1 Then
　　For i = n To p Step -1　　'……(2)'印刷したいページ以上ある場合。以降の改ページを印刷範囲外に追い出す。
　　　sh_B1.HPageBreaks(i).DragOff Direction:=xlDown, _
　　　　　　　　　　　　　　　RegionIndex:=1
　　Next
　ElseIf n < p - 1 Then
　　For i = 1 To n　　　　　　'……(3)'ページ数が足りない場合
　　Set sh_B1.HPageBreaks(i).Location = _
　　　sh_B1.Range("A" & Range("Area" & i).Row + Range("Area" & i).Rows.Count)
　　Next
　　For i = n + 1 To p - 1　　　'……(4)'不足改行分を追加
　　　 sh_B1.HPageBreaks.Add _
　　　 sh_B1.Range("A" & Range("Area" & i).Row + Range("Area" & i).Rows.Count)
　　　　Next
　End If
　　
　 For i = p - 1 To 1 Step -1　'……(5)'改行の位置を設定
　　　sh_B1.Activate
　　　 Set sh_B1.HPageBreaks(i).Location = _
　　　 sh_B1.Range("A" & Range("Area" & i).Row + Range("Area" & i).Rows.Count)
　 Next

・ツリー全体表示


	【81577】セルを分割し別ブックに保存する

あお - 20/12/16(水) 22:36 -


	引用なし

	パスワード

VBA初心者です。
題名の件に関して、お教え願います。

同じブック内にあるセルを、それぞれ別ブックに保存したいです。
以下の条件を入れたいです。

①各シートのセルD4に文字が入っているのですが、同じ文字が入っているシート同士は同じブック内に入るようにしたいです。

②ファイル名は、セルD4に入力されている文字にしたいです。

③シートを保護したいです。

④分割前のファイルを「IN」フォルダに入れると、分割後のフォルダが「OUT」フォルダに入るようにしたいです。

⑤分割前のファイルとは別のファイルに、VBAを作成したいです。

お手数をおかけしますが、どなたか詳しい方、よろしくお願い致します。

・ツリー全体表示


	【81576】Re:複数選択したセル

OK - 20/12/15(火) 9:33 -


	引用なし

	パスワード

VBAではないですが。

Ctrlキーを押しながら選択したい順に
セルを選択していけば、TabキーやEnter
キーで選択した順にセルを移動できます。

セルを選択した状態で名前ボックスで名前
を付けておけば、セルの選択しなおしも簡単
です。

・ツリー全体表示


	【81575】Re:複数選択したセル

moro - 20/12/12(土) 22:40 -


	引用なし

	パスワード

▼moro さん：

動作完璧でした！For each を使えばよかったんですね。
ありがとうございます。

・ツリー全体表示


	【81574】Re:複数選択したセル

［名前なし］ - 20/12/12(土) 21:23 -


	引用なし

	パスワード

シートにActiveXコントロールのコマンドボタンを配置し

Private Sub CommandButton1_Click()
Dim aRange As Range, bRange As Range, cRange As Range
Dim Sh As Worksheet
Dim Fl As Integer

Set aRange = Selection
Set bRange = ActiveCell

Fl = 0
For Each cRange In aRange
　Select Case Fl
　Case Is = 0
　　If bRange.Address = cRange.Address Then Fl = 1 '照査セルが対象セルか？
　Case Is = 1 '一つ前の照査セルが対象セルなら
　　cRange.Activate
　　Fl = 3
　　Exit For
　End Select
Next

If Fl < 3 Then　'ActiveCellが変更されなければ
　aRange.Activate '先頭を選択
End If

End Sub

・ツリー全体表示


	【81573】Re:VBA データが多い場合

［名前なし］ - 20/12/12(土) 20:15 -


	引用なし

	パスワード

Sub deta()

Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim forNo As Variant, toNo() As Variant
Dim setRow As Integer, cMax As Integer
Dim aRange As Range, bRange As Range
Dim toRow As Integer, toCol As Integer
Dim i As Double, foi As Double, toi As Double, n As Integer

forNo = Array("A1", "C1", "G1", "B1") 'コピー元（Sh1）のセル位置
toNo = Array("A1", "B1", "C1", "B2")　'コピー先(Sh2）のセル位置
setRow = 2　　　　　　　　　　　　　　'コピー先１セットの行数

cMax = UBound(forNo)
Set Sh1 = ThisWorkbook.Sheets("シート１")
Set Sh2 = ThisWorkbook.Sheets("シート２")

Set aRange = Sh1.Range("A1").CurrentRegion '元データー範囲
'Set aRange = Intersect(aRange, aRange.Offset(1, 0)) '１行目を省く
Set aRange = Intersect(aRange, aRange.Columns(1)) 'A列に絞る
'aRangeのセル数（行数）分転記する。
Sh2.Range("A1:ZZ1000").ClearContents　　　'転記先をクリアー？

For Each bRange In aRange
　 i = bRange.Rows.Row
　 foi = i - 1
　 toi = foi * setRow
　　 Debug.Print bRange.Address, i, toi
　 For n = 0 To cMax
　　　Sh2.Range(toNo(n)).Offset(toi, 0).Value = Sh1.Range(forNo(n)).Offset(foi, 0).Value
　 Next
Debug.Print bRange.Address, i, toi
Next

Set aRange = Nothing
Set bRange = Nothing
Set Sh1 = Nothing
Set Sh2 = Nothing

End Sub

・ツリー全体表示


	【81572】複数選択したセル

moro - 20/12/12(土) 19:18 -


	引用なし

	パスワード

VBA初心者です。

複数選択されたセルをそれぞれ順番にアクティブにする方法があれば教えてください。

例えば

A3セル、B5セル、C1セル、H17セルが選択された状態で順番にアクティブにしていくというもので、検索のダイアログボックスの”次を検索ボタン”との同じ機能を果たすとうイメージです。できればコマンドボタンでできればと思っていますのでよろしくお願いします。

・ツリー全体表示


	【81571】VBA データが多い場合

ゆきだるま - 20/12/11(金) 14:52 -


	引用なし

	パスワード

【VBA】初心者です。
シート１にある例①のデータを
シート２のテンプレートに例②の形にしたいです。

実際は、26項目分、テンプレートに当てはめたいデータがあります。
データは300行分くらいあります。
最終的には、番号や住所などのセルは複数行、結合させることになります。（結合までいっきにできるとなおよいです。）

Set deta()
Dim torikomi1 As Range, template1 As Range
Dim torikomi2 As Range, template2 As Range
↑このようなかたちで、26個続きます。

Dim Z Az Long, R As Long

This Workbook.Sheets("シート１").Range("A1:ZZ1000").ClearContents

Set torikomi1=Worksheets("シート１").Cells(2,1)
Set　torikomi2=Worksheets("シート１").Cells(2,2)
↑このようなかたちで、26個続きます。

Set template1 =Worksheets("シート２").Cells(3,1)
Set template2 =Worksheets("シート２").Cells(4,2)
↑このようなかたちで、26個続きます。

For Z = 0 To 2500 Set 2
　 template1.Offset(Z,0).Value = torikomi1.Offset(R,0).Value
　template2.Offset(Z,0).Value = torikomi2.Offset(R,0).Value
↑このようなかたちで、26個続きます。
R=R+1
Next Z
End Sub

26項目分なので、開くのも閉じるのも時間がかかってしまいます。
ほかに、よい方法はありますでしょうか？
よろしくお願いします。

例①
1番号名前ふりがな月日年住所
2 13　佐藤さとう 3 2 北海道
3 15 伊藤いとう 5 12 青森
4　　　　　　　　
5

例②
1 番号ふりがな住所
2　　　名前
3 13　さとう北海道
4　　　佐藤
5 15　いとう青森
6　　　伊藤

・ツリー全体表示


	【81570】Re:リストボックスのデータ削除・追加

OK - 20/12/7(月) 17:02 -


	引用なし

	パスワード

色んな方法がありますが、こんな方法も。

全てのを網羅したリストをシートなどに作っておく

シート2に転記したデータにリストにフラグを立てて、
フラグが立ってないものだけでListBox1のリスト
を作成しなおす

シート2から削除した時点で削除したもののリスト
のフラグを下ろして、リストのフラグが立っていない
もののみをListBox1に再格納

・ツリー全体表示


	【81569】Re:リストボックスのデータ削除・追加

OK - 20/12/7(月) 9:11 -


	引用なし

	パスワード

リストより削除
RemoveItem

リストに追加
AddItem

参考HPです。

ht tps://www.officepro.jp/excelvbaform/form_list/index4.html

・ツリー全体表示


	【81568】Re:taskkill.exeを実行する際のウィンド...

OK - 20/12/7(月) 8:26 -


	引用なし

	パスワード

当方Windouws10、Excel2007です。
私の環境ではエラーは起きませんでした。
環境によって違ってくるかもしれません。
他の回答者のレスをお待ちください。

・ツリー全体表示


	【81567】リストボックスのデータ削除・追加

ビギナー - 20/12/7(月) 1:01 -


	引用なし

	パスワード

こんばんは。ユーザーフォーム上に配置した複数選択可能なリストボックスが
あります。このリストボックスにはシート１のデータが表示されるようになって
いるのですが、ここで選んだデータは、同ユーザーフォーム上にあるコマンド
ボタンを押すと、シート２に記入されるようになっています。
この時、選択していたデータ（複数又は１個だけの場合もあり）は、リスト
ボックスから消えるようにしたいのと、シート２に記入されたデータを消す
とまたリストボックスの中に復活するようにするにはどうしたらいいので
しょうか？

・ツリー全体表示


	【81566】Re:リストを表示したが、それ以外の入力...

myu - 20/12/6(日) 21:09 -


	引用なし

	パスワード

VBAを使わなくても「データの入力規則」で解決しました。
お騒がせを致しました。

・ツリー全体表示


	【81565】リストを表示したが、それ以外の入力もし...

myu - 20/12/6(日) 16:35 -


	引用なし

	パスワード

お世話になります。
業務シートにコメントシートから以下のコードでリストを作成したのですが、
指定したコメント以外は入力できません。
セルにそれ以外のコメントを入力するには、どうしたらよいでしょうか？
ご教示ください。

Private Sub Worksheet_Activate()
Dim items() As Variant　
　　items = WorksheetFunction.Transpose(Sheets("コメント").Range("B2:B20").Value)
　　With Sheets("業務").Range("B30").Validation
　　　　.Delete
　　　　.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(items, ",")
　　End With
End Sub

・ツリー全体表示


	【81564】Re:セルをダブルクリックしたら

moro - 20/12/6(日) 15:38 -


	引用なし

	パスワード

▼マナさん：
>▼moro さん：
>
>End(xlToLeft)で、右端セルがどこかを調べてはどうでしょうか。

返信が遅くなってすみませんでした。
かなりヒントになりました

i = Target.Address(RowAbsolute:=False, ColumnAbsolute:=False)

Target.Range(i, "XX" & Mid(i, 2)).Copy

これで自分がやりたいと思っていることができました。
ありがとうございました！

・ツリー全体表示


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

45 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free