Results of 1 - 1 of about 103 for フォーマット 自動 印刷 (0.009 sec.)
フォーマット (1423), 自動 (14517), 印刷 (5708)
- [[20040625010324]]
- #score: 8138
- @digest: 7a184108cf35cd58e895f5b7caa80b05
- @id: 7355
- @mdate: 2004-08-02T02:22:45Z
- @size: 30343
- @type: text/plain
- #keywords: mecol (134426), merow (103607), tennki (77615), 成- (54636), 中- (42672), 似様 (35713), ”“ (34096), 夏目 (32230), 目雅 (28091), 雅子 (25290), 受注 (23411), 子似 (21517), 作中 (16510), 製作 (12915), 完成 (11946), 出荷 (11442), xltoleft (7569), 記先 (6544), target (4552), 転記 (3834), シー (3765), entirerow (3504), ート (3263), integer (3241), 項目 (2926), column (2789), ーマ (2593), デー (2356), ” (2118), リス (2086), ータ (2083), range (2078)
- 『商品出荷管理表』（あっちゃん）
今、商品管理表を作成しています。 Sheet 1に受注、Sheet 2に完成、Sheet 3に出荷 というデータがあります。 フォーマットは、すべてのSheet に共通です。 まず、今、手作業として 1.Sheet 1（受注）にてデータを打ち込む。 2.数日後、商品が完成したらA列の状況を変更する。受注 → 完成 データは100行近くになり、またランダムに変更になる。 例えば、今は、3行目と5行目が、受注 → 完成 で、4行目はそのままとか。 3.A3受注と入力してあるデータを完成と直し、その行を切り取り、Sheet 2（完成）に”切り取ったデータ挿入”で、データを入れる。 4.挿入後のデータは、B列でソートをかけて、番号順にする。 5.Sheet 2（完成）の中のデータで、出荷したもののA列の状況を完成から出荷に直し、その行を切り取り、Sheet 3（出荷）に”切り取ったデータ挿入”で、データを入れる。 6.挿入後のデータは、B列でソートをかけて、番号順にする。 なんとか、現在手で行なっている作業を、瞬時に手軽に出来ないものかと思います。 また、A列の状況データーの修正数は日によって変更します。 その上、、各Sheet に入っているデーター100行近くあります。 よろしくお願いいたします。 A B C D E F 1 状況 製造番号 納入先 品名 部品手配 etc 2 受注 ア123 アイ商事 ザル 7/10 ・・・ 3 受注 ア456 ウエ商事 カゴ 8/10 ・・・ 4 受注 ア789 カキ商事 ザル 10/10 ・・・ 5 受注 ア125 サシ商事 ザル 7/10 ・・・ excel2000 Win2000 ------ おはようございます。 朝起きてぱっと見ただけで、、なんか嫌な予感がしないわけでもないのですが、、 多分、、???こんな感じかと思います。 昨日の今日なんで少しショックが残っていて、 最後まで、お付き合いできないかとは思いますが、とりあえずこんな方法もあり という程度でお考え下さい。 動けばいいじゃんマクロで外してても許してくれるという寛大なお気持ちのもと、、? でよければ、使ってみてください。 では、、清水の舞台より、ダイブしてみます。。。 （夏目雅子似） ↓これを全てのシートに貼り付けて下さい '当該シートがアクティブになったら、製品番号をキーにソートする。 Private Sub Worksheet_Activate() Application.ScreenUpdating = False Range("A1").CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin Application.ScreenUpdating = True End Sub ↓これを受注シートに貼り付けてください '受注シート用 Private Sub Worksheet_Change(ByVal Target As Range) Dim KR As Integer Dim R As Integer Dim C As Integer Dim i As Integer If Target.Count > 1 Then Exit Sub If Target.Column <> Range("A:A").Column Then Exit Sub i = Range("A1").End(xlToRight).Column() MsgBox i←消して下さい。 KR = Sheets("完成").Range("B65536").End(xlUp).Row() + 1 MsgBox KR←消して下さい。 R = Target.Row MsgBox R←消して下さい。 Application.EnableEvents = False If Target.Value = "完成" Then For C = 1 To i Sheets("完成").Cells(KR, C).Value = Cells(R, C).Value Next C Target.EntireRow.Delete Shift:=xlUp '訂正 End If Application.EnableEvents = True End Sub ↓これを完成シートに貼り付けて下さい '完成シート用 Private Sub Worksheet_Change(ByVal Target As Range) Dim KR As Integer Dim R As Integer Dim C As Integer Dim i As Integer If Target.Count > 1 Then Exit Sub If Target.Column <> Range("A:A").Column Then Exit Sub i = Range("A1").End(xlToRight).Column() MsgBox i←消して下さい。 '▲完成シートから出荷シートへの転記する為の最終行+1を取得しています。 '従って、Sheets("出荷")を転記先のシート名に変更にして下さい。 KR = Sheets("出荷").Range("B65536").End(xlUp).Row() + 1 MsgBox KR←消して下さい。 R = Target.Row MsgBox R←消して下さい。 Application.EnableEvents = False '▲入力した文字が「出荷」だったら「出荷」と言う名前のシートに転記を実行します。 '従って"出荷"と言う文字を実行したい文字に変更してください。 If Target.Value = "出荷" Then For C = 1 To i Sheets("出荷").Cells(KR, C).Value = Cells(R, C).Value Next C Target.EntireRow.Delete Shift:=xlUp '訂正 End If Application.EnableEvents = True End Sub 多分?動くと思いますが、外してたら、、ごめんなさいm(__)m では、行ってきます。 ------- すみません! ど素人の為、意味がわかりません。 また、どんような場面で↑を貼り付けてよいのかわかりません。 マクロは、メニューを広げたこともありません。 どうか、後学のために意味も教えて下さい。 違う場面で応用がきくように。 宜しく御願いします。 ---- 「ツール」「マクロ」 Visual Basic Editorをクリック 左側のプロジェクトにブック内に存在するsheetがツリー型で表示されていますよね! そのsheet（受注、完成、出荷）をダブルクリックして上記の構文を貼り付ける という作業だと思います。 （HISA) HISAさまありがとうございました。 また、マクロを教えて頂いたお方さま、ありがとうございました。 すばらしい〜! 自分が想像していたこんなことできたらな〜と思っていたこと以上にすばらしい〜動き! 鳥肌がたちました。 後学のために式の意味も教えて頂けませんか? あっ、すみませ〜ん! 今、受注シートに新規データを入力し、A列に"受注"と入力したとたん、マクロが起動し、データが、受注シートに残らなくなってしまいました。 A列が受注の場合は、このシート上に残したいのですが・・・。 データどこに行ったのでしょうか? 教えて下さい。 宜しく御願いします。 ---- コードを見ましたが、A列に何らかの変更がされると元データは削除されてしますようです。 '受注シート用マクロと '完成シート用マクロの中にある Target.EntireRow.Delete Shift:=xlUp を If ......... End Ifの中に入れてあげる必要があります。 受注シート用マクロ If Target.Value = "完成" Then For C = 1 To i Sheets("完成").Cells(KR, C).Value = Cells(R, C).Value Next C Target.EntireRow.Delete Shift:=xlUp End If 完成シート用マクロ If Target.Value = "出荷" Then For C = 1 To i Sheets("出荷").Cells(KR, C).Value = Cells(R, C).Value Next C Target.EntireRow.Delete Shift:=xlUp End If にして両方の元の位置あるTarget.EntireRow.Delete Shift:=xlUp を削除 すれば、OKだと思うのですが。 (jindon) jindon さま ありがとうございました。 受注シートに↑をコピーして、A列データー 受注 → 完成 としたら 実行424エラー オブジェクト 確認して下さい。 Target.EntireRow.Delete Shift:=xlUp にチェックが入ってしまいました。 何故? ---- よく確認しませんでした。 ↑訂正してありますので。大丈夫だと思うのですが。 もし、マクロが作動しなかったら Application.EnabelEvents がFalseの状態 のままかもしれませんので、 Sub Test() Application.EnabelEvents=True End Sub を ThisWorkbookのモジュールに貼り付けて作動させてください。 方法: シートタブを右クリックしてVBE画面に入り、左画面のThisWorkbookをダブルクリック。 上記のコードを貼り付けて、excel画面に戻り ツール→マクロ→マクロ→ThisWorkbook.Testを選択して 実行 です。 かえって、ややこしくしてしまって申し訳ありません。 (jindon) ----- ぎゃ〜〜〜、また、また、ずっこけたみたいで汗(>_<) HISA様 jindon様フォローありがとうございます。m(__)m トピ主のあっちゃん様どうか、お許しくださいませm(__)m 私、ただいまバリ仕事中(*_*) 訂正しておきました。m(__)m （夏目雅子似） jindon さま ありがとうございました。 「↑訂正してありますので。大丈夫だと思うのですが。」 この部分だけで動きました。 感謝!感謝!です。 みなさま 本当にありがとうございました。 また、是非教えて下さい。 （あっちゃん） お久しぶりです。 以前教えて頂いてから毎日毎日使わせて頂いています。 ですが、だんだん欲が出来てしまって〜（;^^A） また教えて下さい。 1.新しくファイルを作り、1つのシートを次々（2つ計3シート）コピーして、以前教えて頂いたマクロをコピーし貼り付けました。 が、 実行時エラー“1004” 同じサイズの結合セルが必要 と出てきます。??? 何故でしょうか? 2.以前お聞きした時は、“受注”“完成”“出荷”という3シートでしたが、“受注”“製作中-1”“製作中-2”“完成-1”“完成-2”など計11シートを作成し、出荷管理表を詳細にしたいと思います。 どのように、マクロを変更したらよいでしょうか? 3.ずうずうしいお願いなのですが、 A列のデータを変更する度に Microsoft Excel 256 OK Microsoft Excel 6 OK Microsoft Excel 6 OK と聞いてきます。 これをパスできないでしょうか? よろしくお願いいたします。 ------ こんばんわ!あっちゃん様、トピを見ていたら、私の名前がぁ(@_@) >実行時エラー“1004” >同じサイズの結合セルが必要 >と出てきます。??? 何故でしょうか? これは、その名の通り結合セルがある為と思われます。 結合セルを解除して下さい。 >2.以前お聞きした時は、“受注”“完成”“出荷”という3シートでしたが、“受注”“製 作>中-1”“製作中-2”“完成-1”“完成-2”など計11シートを作成し、出荷管理表 を詳細に>したいと思います。 >どのように、マクロを変更したらよいでしょうか? 上のコードに▲で説明を入れましたので、応用してください。 >と聞いてきます。 >これをパスできないでしょうか? これは、私の癖といいますかぁ、、↓の為です。 これを、消してください。m(__)m 上のコードには一応書いておきました。ごめんなさいm(__)m （夏目雅子似） MsgBox R←消して下さい。 MsgBoxとある個所を全て消して下さい。 ------------------ 出社一番、昨夜教えて頂いたことやってみました。 1.「実行エラー」について、以前の同じ3つのシートをコピーし、コマンドを貼り付けました。 結合箇所は確かに1箇所あった（以前の時もあった）ので結合解除し、再度行なってみました。 "受注"シートからデータは"完成"シートには移動したのですが、やはりダメでした。 シート内のデータは6行目から始まっています。（日付・会社名等を入れたため） このことが、このエラーの要因になっているのでしょうか? デバックを確認しましたら、下記のコマンドが黄色になっていました。 Range("A1").CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin 追記） 何度も追記をしてすみません! ルール違反なのでしょうね〜.（ごめんなさい） 1.のことについてですが、 結合個所が別の所にもあり、解除したらよかったのですが、 今度は違うエラーメッセージがでて来ました。 実行時エラー"1004" Rarge クラスの Sort メソッドが失敗しました。 と出て、デバックを確認したら、やはり上記のコマンドが黄色でした。 2.以降はまだ1.が出来ないので、進まない状態です。 ちなみに 2.3シート → 11シートについてのコマンド変更についてですが、 必ず“受注”→“製作中-1”に行くわけではなく “受注”→“製作中-2”や“製作中-3” etc（-1、2、3は商品の分類に使っている） どれに行くかわかりません。 もしかしたら、諸般の事情により “受注”→“完成-1” になるかも〜 A列がどれになっても、その「シート名」に行くのでしょうか? お忙しい中申し訳有りませんが、宜しく御願いします。 ---- 衝突しましたぁ、、 色々とある様ですが、一つづついきましょう。 まず、 >シート内のデータは6行目から始まっています。（日付・会社名等を入れたため） >このことが、このエラーの要因になっているのでしょうか? これは、 私の提示したコードがA1を含む範囲としている為です。 従ってコードを↓に変更してください。 Range("A6").CurrentRegion.Sort Key1:=Range("B7"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin それから、A6を選択した状態でCtrl+*を押して選択される範囲が 今回のデータの範囲となりますから、A6とA5が繋がっていると 選択されてしまいます。 その様な場合は、一行あけるなどの工夫が必要です。 それと、↑のコードは並べ替えを記録したものを編集しただけですから ご自身で記録されてみるとよいでしょう。 で、どうでしょう? （夏目雅子似） --------- わ〜い! できました! ありがとうございます! 今、動いたのですが、"受注"シート用、または"完成"シート用だけのプログラムで i=Range("A1").End(xl ToRight).Column()の "A1" は "A6" に変更すべきでしょうか? 現在は、問題動いていますが〜 また、申し訳有りません。 お手を煩わせますが、次の↑の質問（2〜3）もお教え願えませんか? 宜しく御願いします。（あっちゃん） ----- またまた、追記ですみません。 データは、A列"受注""完成""出荷"の項目、V列備考まであります。 夏目雅子似様のおっしゃっています A6 にて”Ctri + *”をしますと範囲を示す色の変化は A4:I6 となっています。 ご指示通り1行入れ A6 で”Ctri + *”をしますと範囲を示す色の変化はありません。 “”受注”シートに1行入れ、また”完成”シート”出荷”シートにも1行入れ データを入れ、A列を”受注” → “完成”にすると 5行目 つまり、本来挿入したい位置より1行上になってしまいます。 また、 “”受注”シートに1行入れ、”完成”シートと”出荷”シートは、そのまま（”完成”と”出荷”シートA列にCtri + *すると、A4:I6になります。）にし、I列までデータを入れると 本来挿入してほしいところにデータがきます。 しかし、”受注”シートJ列にデータを入れたとたん、表は乱れてしまいます。 そこで、 夏目似様のおっしゃっています、1行入れるとは、どのシートの時でしょうか? また、J列に入っているデータ → 入力規則 → リスト は悪影響があるのでしょうか? （各シートの同じ位置にリスト因子は置いてあります） それとも、今回は範囲（A4:I6）が原因でしょうか? よろしくお願いいたします。（あっちゃん） ------ あっちゃんさん こんばんは^^ >夏目似様のおっしゃっています、1行入れるとは、どのシートの時でしょうか? （様はいりません^^;） 私が言いたいのは Range("A6").CurrentRegion を使っているので5行目は空白にしておいて欲しいということです。 つまり、A5に何かがあるとA6を選択した状態でCtrl+*とすると 範囲にA5も含まれませんか? A1 B1 C1 D1 E1 F1 D1 1** ** ** ** ** ** ** 2** ** ** ** ** ** ** 3** ** ** ** ** ** ** 4** ** ** ** ** ** ** 5 6項目1項目2項目3項目4項目5項目6 7**************************** 8**************************** 9**************************** 10*************************** と、なっていて欲しいのです。 さて、それはさておきコードを少し変更してみましたので差し替えてください。 今回のコードはA列に入力したシート名にその行のデータを転記するものです。 例えば、 製作中-2と入力すれば、製作中-2へ 完成-1と入力すれば、完成-1へ 完成-2と入力すれば、完成-2へ転記します。 転記先のシートが無い場合は、メッセージを表示します。 また、自分から自分へは転記しません。 つまり 完成-1シートを選択している状態で完成-1と入力しても転記しません。 コードに区別はありません。全シート共通です。 ただ、 A6からリストがあること。 A5行が空白であること。 が条件です。 で、どうでしょう? （夏目雅子似） '当該シートが選択されたらB列をキーにソートする。 Private Sub Worksheet_Activate() Range("A6").CurrentRegion.Sort Key1:=Range("B7"), _ Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin End Sub '転記したいシート名を入力するとそのシートに当該行のデータを転記する。 Private Sub Worksheet_Change(ByVal Target As Range) Dim tennki_saki As String Dim Wks As Worksheet Dim MyRow As Long Dim C As Integer, i As Integer 'ターゲットの列がA列以外か行が7行より小さかったら無効 If Target.Column <> 1 Or Target.Row < 7 Then Exit Sub 'ターゲットの複数選択を不可にする。 If Target.Count > 1 Then Exit Sub 'ターゲットのDeleteを無効 If Target.Value = "" Then Exit Sub '転記先はターゲットの値 tennki_saki = Target.Value '転記先が自分だったら無効 If Me.Name = tennki_saki Then Exit Sub 'イベントを無効にする。 Application.EnableEvents = False 'ワークシートをループ For Each Wks In Worksheets '変数iを初期化 i = 0 '転記先のシート名とターゲットの値が同じだったら（つまり、転記先のシートがあったら） If Wks.Name = tennki_saki Then '転記先シートのB列を基準に最終行+1を取得 MyRow = Sheets(tennki_saki).Range("B65536").End(xlUp).Row + 1 With Me '変数Cを列数分ループ For C = 1 To .Range("A6").End(xlToRight).Column Sheets(tennki_saki).Cells(MyRow, C).Value = Cells(Target.Row, C).Value Next C '転記が完了したら、ターゲットを削除 Target.EntireRow.Delete Shift:=xlUp End With '転記が完了したらループから抜ける Exit For End If '変数iに1を代入してシートの有無を確認 i = 1 Next '変数iが0じゃなかったら If i <> 0 Then MsgBox "転記先のシート 「" & tennki_saki & "」 は、ありません。" & Chr(13) & _ "転記先のシート名が正しいかもう一度確認して下さい。", vbCritical, "Excelの学校 VBA" End If 'イベントを有効にする。 Application.EnableEvents = True End Sub ------ 朝早起きなのですね〜 尊敬! データをたまたま今はO列まで（全体ではV列まで）しか入力をしなかった場合、そのデータまでは、そのA列記入のシート名のところまでは飛びます。 しかし、挿入状態がうまく行かず、表が乱れます。 今は、 切り取り → 切り取ったセルの挿入（下方向へシフト） という感じで入ってくるのです。 自分がなってほしいのは、 行の切り取り → （7行目以降に）切り取った行の挿入です。 そして、B列をキーにしたソートの実行。 現在は、挑戦をすればするほど、1行目、3行目、2行目などまちまちになってしまいます。 つたない、説明で申し訳有りません。 各シートのフォーマットは受注シートと同じです。（これがいけないのかな〜） それから A列で入力された項目と同じシート名に移動はしました。 さすが〜夏目雅子似 様! 宜しく御願いします。 ------ すみません。いまいちよく分からないのですが、 シートのレイアウトを教えていただけませんか? ↓こんな感じで （夏目雅子似） A1 B1 C1 D1 E1 F1 D1 1** ** ** ** ** ** ** 2** ** ** ** ** ** ** 3** ** ** ** ** ** ** 4** ** ** ** ** ** ** 5 6項目1項目2項目3項目4項目5項目6←ここから下を対象にしています。 7**************************** ↓リスト 8**************************** だから 9**************************** Range("A6").CurrentRegion 10*************************** なんです。A6がリストの左上端でしょ? それから、 >A6からリストがあること。 >A5行が空白であること。 この条件は満たされていますか? >シート内のデータは6行目から始まっています。（日付・会社名等を入れたため） >このことが、このエラーの要因になっているのでしょうか? で、 >A6 にて”Ctri + *”をしますと範囲を示す色の変化は >A4:I6 >となっています。 今回の私が提示したコードは Range("A6").CurrentRegion で、選択される範囲、つまり A6でCtrl+*した範囲を対象にしています。 どこに、リストがあるのかわかりませんが、リストの左上端を A6に置き換えていただけませんか? 意味わかりますか? （夏目雅子似） ---- お手を煩わして申し訳ありません。 A1 B1 C1 D1 E1 F1 D1 1** ** ** ** ** ** ** 2** ** ** ** ** ** ** 3** ** ** ** ** ** ** 4** ** ** ** ** ** ** 5項目1項目2項目3項目4項目5項目6 6 7**************************** 8**************************** 9**************************** 10*************************** 上記のフォーマットのように、空行をただつくれればいいのでしょ? なんて勝手に思い込んでいました。 頭の中を一度精算し、夏目雅子様のおっしゃています通りに フォーマットしてみました。 以前のフォーマットを崩せないので 行を「表示しない」というものを使いながら。 また、I6とK6の間のJ6の項目が「空」になっていました。 ここに「スペース」を1ついれてみましたら、希望するV6までデータが行くようになりました。 自分では、軽く見ていた空のセルの影響を強く感じました。 ここ数日、あなた様の大事な時間を私のために使っていただきありがとうございました。 （コード内容の説明もありがとうございました） また、これに懲りずに教えて下さい。（あっちゃん） ------ あっちゃんさん、こんにちは^^ 解決したのかな? >頭の中を一度精算し、夏目雅子様のおっしゃています通りに >フォーマットしてみました。 あのぅ、コードにシートのレイアウトをあわせなくても A6をリストの左上端の番地に変更していただければいいのですがぁ、、 例えば、A7だったらA7でもいいですし、、 >また、I6とK6の間のJ6の項目が「空」になっていました。 これも、今は .Range("A6").End(xlToRight).Column としてA6から右にカウントしていますが 途中に空白が必要なら .Range("IV6").End(xlToLeft).Column として右端から左にカウントすることもできますし、、 今回の（いつも?）私のコードは全然難しくないです。汗 ポイントは A6がリストの左端上隅であること リストの最終行をB列で判断していることと Range("A6").CurrentRegion を使っているので範囲は実際にその番地でCtrl+*されて確かめられたら いいかと思います。 後は、並び替えのところにB7がありますが、これなんかはA6に対してB7と考えて いただければよろしいかと思います。 それから、並び替えなどは、ほとんどマクロの記録そのままですから 実際に記録されてみてはいかがでしょうか? >ここ数日、あなた様の大事な時間を私のために使っていただきありがとうございました。 全然お気になさらないでくださいませ。 それよりも、私の方こそシートのレイアウトが理解できなくてごめんなさいねm(__)m あっ、少しコードを修正しましたので、よかったら差し替えてください。 それでは、今後とも、よろしくお願い致します。 （夏目雅子似） ----- なんとお優しい言葉でしょう（T-T）（m-m）感謝! ところで、ずうずうしいお話ですが、もう1つ教えて下さい。 B列に記入されている最終行までを、印刷するにはどのようにすればよいでしょうか? 各シート行数が変わるので〜! すみません。宜しく御願いします。 ------ いろんな方法があるとおもいますが、 ThisWorkBookのBeforePrintを使うのはどうでしょう? プロジェクトウィンドウのThisWorkBookをダブルクリックして コードを表示させてそこに↓を貼り付けます。 プロジェクトウィンドウはシートのコードを貼り付けた 左上にあるとおもいます。 Private Sub Workbook_BeforePrint(Cancel As Boolean) Dim MeRow As Long Dim MeCol As String With ActiveSheet 'B列の最終行を取得 MeRow = .Range("B65536").End(xlUp).Row 'リストの最右列の列番地を取得 MeCol = .Range("IV6").End(xlToLeft).Address '各シートの印刷範囲を設定 .PageSetup.PrintArea = "A6" & ":" & Mid(MeCol, 2, 1) & MeRow End With End Sub それから、リストにも途中に空白があるのですね? それでしたら、↓の様にCellsを使って範囲を可変にされてはどうでしょう? '当該シートが選択されたらB列をキーにソートする。 Private Sub Worksheet_Activate() Dim MeRow As Long Dim MeCol As Integer 'B列の最終行を取得 MeRow = Range("B65536").End(xlUp).Row '6行目の最右列を取得 MeCol = Range("IV6").End(xlToLeft).Column 'MeRowとMeColを使ってデータ範囲を設定してソートする。 Range("A6", Cells(MeRow, MeCol)).Sort Key1:=Range("B7"), _ Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin End Sub 転記コードの途中にある↓も .Range("A6").End(xlToRight).Column これに↓に変更された方がよろしいかと思います。 .Range("IV6").End(xlToLeft).Column で、どうでしょう? (夏目雅子似） ------------- 夏目似様 ありがとうございます。 （m_m）（m_m）何とお詫びをして良いかと・・・。 うまくいったので、図に乗って、フォーマットを変更しました。 そしたら、ダメになってしまいました。 行は下記のようにしました。 1 空行 2 リストアップ用データ 3 リストアップ用データ 〜 リストアップ用データ 20 リストアップ用データ 21 空行 22 日付 23 会社名 24 部署 25 空行 26 項目 27 データ 28 データ 29〜データ続く です。 ThisWorkbook には Private Sub Workbook_BeforePrint(Cancel As Boolean) Dim MeRow As Long Dim MeCol As String With ActiveSheet MeRow = .Range("B65536").End(xlUp).Row MsgBox MeRow'←追加 ▲ちなみにここは印刷の幅を決めるところですから最大になる行がよろしいかとおもいます。IV26ぐらいかな?(^^)v MeCol = .Range("IV22").End(xlToLeft).Address MsgBox MeCol'←追加 ▲ちなみにA22から印刷したい場合はA26→A22に(^^)v .PageSetup.PrintArea = "A26" & ":" & Mid(MeCol, 2, 1) & MeRow MsgBox .PageSetup.PrintArea'←追加 End With End Sub を 各シートには Private Sub Worksheet_Activate() Dim MeRow As Long Dim MeCol As Integer MeRow = Range("B65536").End(xlUp).Row MeCol = Range("IV26").End(xlToLeft).Column'▲←ここがない(>_<) Range("A26", Cells(MeRow, MeCol)).Sort Key1:=Range("B27"), _ Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim tennki_saki As String Dim Wks As Worksheet Dim MyRow As Long Dim C As Integer, i As Integer If Target.Column <> 1 Or Target.Row < 7 Then Exit Sub If Target.Count > 1 Then Exit Sub If Target.Value = "" Then Exit Sub tennki_saki = Target.Value If Me.Name = tennki_saki Then Exit Sub Application.EnableEvents = False For Each Wks In Worksheets i = 0 If Wks.Name = tennki_saki Then MyRow = Sheets(tennki_saki).Range("B65536").End(xlUp).Row + 1 With Me For C = 1 To .Range("IV26").End(xlToLeft).Column Sheets(tennki_saki).Cells(MyRow, C).Value = Cells(Target.Row, C).Value Next C Target.EntireRow.Delete Shift:=xlUp End With Exit For End If i = 1 Next If i <> 0 Then MsgBox "転記先のシート 「" & tennki_saki & "」 は、ありません。" & Chr(13) & _ "転記先のシート名が正しいかもう一度確認して下さい。", vbCritical, "Excelの学校 VBA" End If Application.EnableEvents = True End Sub とコードを変更して貼付けました。 うまく行かないのは「印刷」です。 また、実行エラー"1004" アプリケーションエラー とでます。 是非、宜しく御願い致します。 ------- 印刷のコードにメッセージボックスを追加しましたので、 プレビューを押してどの様に表示されるか確認してくださいませんか? こちらでは、別段問題はありませんでした。 （夏目雅子似） ------ または、印刷のコードだけを新規ブックでテストしてみていただけませんか? または、標準モジュールを挿入して Sub 印刷範囲（） Dim MeRow As Long Dim MeCol As String With ActiveSheet MeRow = .Range("B65536").End(xlUp).Row MsgBox MeRow'←追加 MeCol = .Range("IV22").End(xlToLeft).Address MsgBox MeCol'←追加 .PageSetup.PrintArea = "A26" & ":" & Mid(MeCol, 2, 1) & MeRow MsgBox .PageSetup.PrintArea'←追加 End With End Sub としてF8で一つづつ確認していただけませんか? よろしくお願いします。 （夏目雅子似） ----- または、↓としてどうなりますか? Private Sub Workbook_BeforePrint(Cancel As Boolean) Dim MeRow As Long Dim MeCol As Integer With ActiveSheet MeRow = .Range("B65536").End(xlUp).Row MsgBox MeRow MeCol = .Range("IV22").End(xlToLeft).Column MsgBox MeCol .PageSetup.PrintArea = Range("A26", Cells(MeRow, MeCol)).Address MsgBox .PageSetup.PrintArea End With End Sub ---- 割り込み失礼。ちょっと助け舟。 こちらではWorksheet_Activateイベントでエラーが出ます。 変数MeColが取得されていないのでは? MeCol = Range("IV6").End(xlToLeft).Column を誤って削除したものと推測します。 Workbook_BeforePrintイベントは問題ないように思えます。 (KAMIYA) ----- KAMIYA様 ありがとうございます。m(__)m 実は、あせりまっくていましたぁ^^; ほんとですね。↓がないですね。 MeCol = Range("IV6").End(xlToLeft).Column あっちゃんさん、という事ですのでよろしくお願いします。m(__)m （夏目雅子似） ----- みなさんに、ご迷惑をおかけして申し訳ありません。（m_m） 始めに問い合わせて頂いていた時とは、フォーマットを変更したため 以前の項目を6行目 → 26行目にしました。また、印刷をしてほしいのは、会社名含め、22行目からです。 このような理由から、 MeCol = .Range("IV6").End(xlToLeft).Address ↓ MeCol = .Range("IV22").End(xlToLeft).Address に勝手にしてしまいました。 ダメだったのでしょうか? また、 上記印刷の内容をどのようにやっていいのか分からなかったので、ThisWorkbookにコードを貼り付けました。 何度かテストを繰り返しているうちに、 実行エラー”1004” アプリケーション定義またはオブジェクト定義のエラー とでます。 デバックを確認すると、各シートの下記のコードが黄色になります。 Range("A26", Cells(MeRow, MeCol)).Sort Key1:=Range("B27"), _ Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin End Sub さきに進めません。 よろしくお願いいたします。 ------- あのぅ、、 MeCol = .Range("IV6").End(xlToLeft).Address ↓ MeCol = .Range("IV22").End(xlToLeft).Address は、問題ないと思います。 実行エラーはシートを選択した時に発生するのではないですか? 印刷のマクロは印刷を実行する前に発生するイベントですから、 コードをThisWorkBookに貼り付けたら後はプレビューをクリックするか 印刷をクリックすれば自動的に印刷範囲が設定されます。 もしも、動きを確認されたいのでしたら、標準モジュールに貼り付けてF8で確認されて みてもいいでしょう。 それから、不具合個所に▲マークで印を付けてみましたので、確認してください。 何とか解決されるといいですね(^^)V で、どうでしょう? （夏目雅子似） ---- うまくいきました。 夏目雅子似様のおっしゃる通り、 >実行エラーはシートを選択した時に発生するのではないですか? その通りです。 KAMIYA様のおっしゃる通り、1行コードが抜けていました。 あせまくっている上、思い込みが激しい私は、自分の過ちを「きちん」と認識せず、 夏目雅子似様に指摘頂き、▲までつけて頂き、本当に感謝です。 今は、もう家でデータを10個程度しか持ち帰ってきていません。 月曜日にすべてのデータを移してみます。 問題が発生したら是非教えて下さい。 また、月曜日にでもご報告させていただきます。 この数日、夏目似様ありがとうございました。 KAMIYA様も、ありがとうございました。 （あっちゃん） ------ よかったですね。また、少し気になったところがありましたので ▲マークで二つほど入れておきましたので確認してください。 では、(^^)v （夏目雅子似） ------ こんにちは! 週末は、お陰様で気持ちよく過ごさせて頂きました。 ありがとうございました。（m_m） 早速、朝から馬力（豚力）を出して、データを移しました。 印刷部分が何故かうまく行かなかったので、▲マークをつけて頂いたコードを貼り付けました。 バッチリです。 涙がポロポロ。 ありがとうございました。 また、問題がいつか起こったら、是非懲りずに教えて下さい。 宜しく御願いします。（あっちゃん）... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/200406/20040625010324.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97057 documents and 608302 words.
訪問者：