Results of 1 - 1 of about 103 for フォーマット 自動 印刷 (0.009 sec.)
フォーマット (1423), 自動 (14517), 印刷 (5708)
- [[20200605172751]]
- #score: 8138
- @digest: f47c430e5bb4c96f4197ff894705da82
- @id: 83929
- @mdate: 2020-06-17T00:01:29Z
- @size: 48678
- @type: text/plain
- #keywords: myshap (154683), lngrow (154387), aj26 (137807), 納期 (18242), 備考 (18212), trim (17218), 隠居 (16779), 注文 (15516), 注書 (15252), topleftcell (11371), 居じ (10766), じー (10384), 単価 (10295), text (10167), 2020 (9990), cells (9527), 数量 (8390), 支払 (7971), value (7960), txt (6519), soulman (6237), 品名 (6201), me (6130), 発注 (5708), （隠 (5567), シェ (5417), 登録 (5173), 火) (5103), shapes (4840), ーさ (4561), 保護 (4504), case (4379)
- 『答えによって、オートシェイプで〇をつけたいです。』（ちえこ）
AJ26に数字が出るんですが、1の場合はF26に〇 2の場合には、F27に〇 3の場合には、F31に〇を付けたいです。 AJ26は数字がない場合もあります。 その場合には、〇は表示しないようにしたいです。 宜しくお願いします。 ＜ 使用 Excel:Office365、使用 OS:Windows10 ＞ ---- 数式で◯の表示を切り替える、ではだめですか? シェイプに拘るのなら、画像の切り替え、という方法があります。 シェイプで使えるかは未検証です。 http://www.officetanaka.net/excel/function/tips/tips14.htm （OK） 2020/06/05(金) 17:40 ---- なぜオートシェイプで〇をつけたがるのですか。 （touda） 2020/06/05(金) 17:47 ---- 仕事で1を選んだら丸を付けるという書類を作成するからです。 わざわざ何枚も付けてるのは、面倒なので答えを選んだら自動的に丸がつくように、したいのです。 （ちえこ） 2020/06/05(金) 21:54 ---- オートシェイプに拘る理由になってません。 説明聞いて、なお数式の方がいいのでは?と 思うのですが。 （OK） 2020/06/05(金) 21:55 ---- たぶん、AJ26に1を入力したときに、 例えばF26に、1.はい みたいものを入力しておき、その「1.」のところにオートシェイプで ○を重ねて表示したい・・・みたいなことかと、勝手に想像しています。 （自信なし） 2020/06/05(金) 22:14 ---- AJ26に入る数字は1と2だけですか。それ以外にもあり得るのですか。 （touda） 2020/06/05(金) 23:16 ---- おはようございます。。 一応、動作確認はした。。。つもり、、です。 シートモジュールに貼り付けます。。。 どうかなぁ??? Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$AJ$26" Then Exit Sub Select Case Target.Value Case 1 kk Me, Me.Range("F26") Case 2 kk Me, Me.Range("F27") Case 3 kk Me, Me.Range("F31") Case Else kk Me End Select End Sub Sub kk(ByVal MySh As Worksheet, Optional ByVal r As Range) Dim myshap As Shape With MySh For Each myshap In .Shapes If Not Intersect(.Range("F26,F27,F31"), .Range(myshap.TopLeftCell.Address, .Range(myshap.BottomRightCell.Address))) Is Nothing Then myshap.Delete End If Next If Not r Is Nothing Then With .Shapes.AddShape(msoShapeOval, r.Left, r.Top, r.Width, r.Height) .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(0, 0, 0) .Line.Weight = 1 End With End If End With End Sub （SoulMan） 2020/06/06(土) 06:24 ---- SoulManさま おはようございます ^^ バッチぐ〜ですよ (*^^*)v m(_ _)m （隠居じーさん） 2020/06/06(土) 07:41 ---- オートシェープは、あらかじめ適正な位置に、適正な大きさで貼り付けてある気がするなぁ。 すると、単に表示/非表示を切り替えればよさそう。 図形が楕円1〜3だとして、以下のマクロをシートモジュールに貼り付け Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) = "AJ26" Then Me.Shapes.Range(Array("Oval 1", "Oval 2", "Oval 3")).Visible = msoFalse Select Case Target.Value Case 1: Me.Shapes("Oval 1").Visible = msoCTrue Case 2: Me.Shapes("Oval 2").Visible = msoCTrue Case 3: Me.Shapes("Oval 3").Visible = msoCTrue End Select End If End Sub （半平太） 2020/06/06(土) 08:12 ---- | AJ26に数字が出るんですが、 出るという言葉からすると、 AJ26は式が入っていて、直接の入力項目ではないということはありますか? AJ26に範囲を限定したChangeイベントプロシージャでは捕捉できないかも。 | わざわざ何枚も付けてるのは、面倒なので ここの意味がよくわからないです。何枚もつける、とは? ちなみに、AJ26に相当する箇所はどのくらいの数があるんですか? その辺も、質問者さんが実際にコードを書かれるときにポイントになりそうな気がします。 （γ） 2020/06/06(土) 10:33 ---- 皆様 ありがとうございます。 AJ26はVLOOKUPが入っています。 その答えをもとにオートシェイプで〇を付けます。 会社の決まられている書類なので、沢山作成するので、 いちいち〇を付けているのが面倒なので、お願いしてみました。 いろいろ試してみたいと思います。 （ちえこ） 2020/06/08(月) 08:58 ---- >いちいち〇を付けているのが面倒なので、 オートシェイプを何枚も作成する方がもっと面倒と思うけど。 >お願いしてみました。 それに関する回答がほとんどないのはなぜか。回答者に対する態度が悪い。 （touda） 2020/06/08(月) 09:32 ---- 態度が悪いってどういう事ですか? そんなつもりありません。 オートシェイプが面倒だから自動化するのに相談してみただけなのに、 そんな言われ方するなんて酷いです。 解らないから相談するのがいけないんですか? （ちえこ） 2020/06/08(月) 10:49 ---- 他人が口を挟むようですけど >そんなつもりありません。 だったら回答者に返信するのが常識だと私は思います。 （wakara） 2020/06/08(月) 11:53 ---- 出勤中に質問したので、会社に来て開きました。 返信が遅れたことは、悪いと思います、仕事中での返信になってしまったので 見るのが遅れてしましました。 （ちえこ） 2020/06/08(月) 12:10 ---- ああ、やはり計算式が入っているのですか。 それなら、AJ26が参照しているセルを変更したときに、 という起動条件にする必要がありますね。 一例ですけど、 If Not Intersect(Target, Range("B1").Precedents) Is Nothing Then など。 （ただし、Precedentsはそのシート内に限定されるので、他シート参照していたらさらに そこも見る必要がありますかね） あとは頑張ってください。 （γ） 2020/06/08(月) 13:21 ---- B1は間違い 、無論AJ26です。 （γ） 2020/06/08(月) 16:31 ---- 有難う御座います。 明日会社でやってみます。 （ちえこ） 2020/06/08(月) 23:32 ---- こんばんは! 見逃してましたぁ(^^; AJ26の値が計算式によって変更された時という事なら楕円を書くコードは同じで Changeを以下に差し替えて下さい。。。 Option Explicit Private Sub Worksheet_Calculate() Static x As Variant If x = Me.Range("AJ26").Value Then Exit Sub Select Case Me.Range("AJ26").Value Case 1 kk Me, Me.Range("F26") Case 2 kk Me, Me.Range("F27") Case 3 kk Me, Me.Range("F31") Case Else kk Me End Select x = Me.Range("AJ26").Value End Sub 隠居じーさん さん いつもありがとうございます。 返事すると怒られますからね(^^; 楽しくいきましょうね v(=∩_∩=)v （SoulMan） 2020/06/09(火) 19:21 ---- こんばんは ^^ 。。。 何時も、お気遣いありがとうございます。 良い加減な、ことばかり、言いまして大変、相済みません。 ＞＞楽しくいきましょうね v(=∩_∩=)v 同感です。 ちえこさん、横入りすみませんでした。 m(_ _)m （隠居じーさん） 2020/06/09(火) 19:51 ---- （SoulMan） 2020/06/09(火) 19:21 （隠居じーさん） 2020/06/09(火) 19:51 ここは質問欄です。個人的な挨拶はやめようぜ。 閲覧していて不愉快になった人より （不愉快になった人） 2020/06/10(水) 09:10 ---- ここのようなQ&Aサイトではよくあることです。 規約などでも禁止されてないです。 いやなら自分で規約でがんじがらめな Q&Aサイトを作るか、そういうサイトを 探してそこだけを閲覧すればいいことでです。 （不愉快にならなかった人） 2020/06/10(水) 09:36 ---- SoulManさん お早うございます。 お返事ありがとうございます。 教えてくださった、マクロにするとSubまたはFunctoinが定義されてませんと出てしまいます。 どうしてでしょうか? （ちえこ） 2020/06/15(月) 09:52 ---- こんにちは ^^ SoulManさん多分いまお仕事で、夜しか、こちらには登校されないかもしれません。 あのぉ〜下にあった Sub kk ↓ End Sub 消していませんでしょうか。←恐る恐る。。。こわごわ ^^;。。。。m(_ _)m （隠居じーさん） 2020/06/15(月) 10:12 ---- 隠居じーさん こんにちは。 ありがとうございます。 ちゃんと入っているんですが…? 出来ないというか動かないですね… （ちえこ） 2020/06/15(月) 13:11 ---- こんにちは ^^ そぉなんですね。こちらでは動いていますので、何か、動作環境が違うのでしょうね。 エラーメッセージを拝見させて戴いた限りでは、何らかの要因でkkと云うプロシジャー が認識されていないようです。どちらのモジュールに有るのか教えていただきますと、 お手伝い出来るかもしれません。m(_ _)m （隠居じーさん） 2020/06/15(月) 13:29 ---- 隠居じーさん様 お返事ありがとう御座います。 Private Sub Worksheet_Calculate() Static x As Variant If x = Me.Range("AJ26").Value Then Exit Sub Select Case Me.Range("AJ26").Value Case 1 kk Me, Me.Range("F26") Case 2 kk Me, Me.Range("F27") Case 3 kk Me, Me.Range("F31") Case Else kk Me End Select x = Me.Range("AJ26").Value End Sub chengeという所です。 間違っていますでしょうか? 発注書というシートにデータがあるんですけど、そこから開発を開いてコードをコピペしました。 kkという所が黄色くなりエラーが出ます。 宜しくお願いします。<(_ _)> （ちえこ） 2020/06/15(月) 13:50 ---- Sub kk(ByVal MySh As Worksheet, Optional ByVal r As Range) Dim myshap As Shape With MySh For Each myshap In .Shapes If Not Intersect(.Range("F26,F27,F31"), .Range(myshap.TopLeftCell.Address, .Range(myshap.BottomRightCell.Address))) Is Nothing Then myshap.Delete End If Next If Not r Is Nothing Then With .Shapes.AddShape(msoShapeOval, r.Left, r.Top, r.Width, r.Height) .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(0, 0, 0) .Line.Weight = 1 End With End If End With End Sub もし ↑ が 存在していませんでしたら、今ある、コードの下に ↑ を コピペ して、貼り付けてみて下さい。 ^^;。。。うまくいくと。。いいですね。m(_ _)m （隠居じーさん） 2020/06/15(月) 13:57 ---- 隠居じーさんさま 有難うございます。 やってみましたが、エラーは出なくなったものの、何も変化はありません。 他にもマクロがあるから、動かないのでしょうかね? 初心者なのでなんと説明していいのか分りませんが、ユーザーフォームで登録してその結果をVLOOKUPで検索して表示・印刷なのですが… マクロは勉強しないとですね。 奥深い…(´;ω;｀) （ちえこ） 2020/06/15(月) 14:54 ---- こんにちは ^^ エラーは消えたのでしたら、今回はイベント処理が変更になっていますので。 ＞＞VLOOKUPで検索 ← これを変化させてあげると〇が表示されるはずな のですが。ご確認を、 ＞＞他にもマクロがあるから、動かないのでしょうかね? 新規ブックのシートSheet1 にSoulmanさんのコードのみ、コピペして、AJ26 の数式を=A26にでもして、A26に1,2,3を順次入力してみて下さい。動くと思います。 （隠居じーさん） 2020/06/15(月) 16:45 ---- あ!ちょっと待ってくださいね。 (◎_◎;) （隠居じーさん） 2020/06/15(月) 16:45 は無視してください。 わたしも大きな勘違いしているかも。。。調べてみます。 引き続き他の方の回答もお待ちくださいね。済みませんm(_ _)m （隠居じーさん） 2020/06/15(月) 16:58 ---- こんばんは ^^ ↑の実験の件です。 お待たせいたしました、Sheet1のA26に =Sheet2!A1 といれて Sheet2のA1に入力してみて下さい。[ま、おなじかもですが ^^;] あと、一息!みたいなところまで来ていると思いますので、頑張ってくださいね ＞＞マクロは勉強しないとですね。 ＞＞ 奥深い…(´;ω;｀) わたしも同じですよ。でも完成すれば便利ですよね(#^^#) では。。。m(_ _)m （隠居じーさん） 2020/06/15(月) 17:34 ---- こんにちは! 取り敢えずシートモジュールに貼ってあるコードをそのまま ここへコピペしてください 先ずは新規Bookで検証しましょう それから実際のBookで試してみましょう （SoulMan） 2020/06/15(月) 18:38 ---- こんばんは ^^ ＞＞お待たせいたしました、Sheet1のA26に =Sheet2!A1 といれて Sheet1のAJ26に =Sheet2!A1 といれて の間違いですね。済みませんでした。(￣▽￣)。。。(*^^*)///。m(_ _)m （隠居じーさん） 2020/06/15(月) 18:47 ---- 隠居じーさん さん いつもありがとうございます😊 再計算が行われたら動くでしょ? （SoulMan） 2020/06/15(月) 19:15 ---- 今、↓このコードを新規Bookで検証しましたがVlookup関数でも動きましたよ? ただ、Vlookupの様に検索値が見つからなかった時にエラーになる様なので If IsError(Me.Range("AJ26").Value) Then Exit Sub を追加しました。。。。 再計算が行われて、、、x が変化して 1か2か3だったら引っ掛かると思いますが、、、どうでしょう??? Option Explicit Private Sub Worksheet_Calculate() Static x As Variant If IsError(Me.Range("AJ26").Value) Then Exit Sub If x = Me.Range("AJ26").Value Then Exit Sub Select Case Me.Range("AJ26").Value Case 1 kk Me, Me.Range("F26") Case 2 kk Me, Me.Range("F27") Case 3 kk Me, Me.Range("F31") Case Else kk Me End Select x = Me.Range("AJ26").Value End Sub Sub kk(ByVal MySh As Worksheet, Optional ByVal r As Range) Dim myshap As Shape With MySh For Each myshap In .Shapes If Not Intersect(.Range("F26,F27,F31"), .Range(myshap.TopLeftCell.Address, .Range(myshap.BottomRightCell.Address))) Is Nothing Then myshap.Delete End If Next If Not r Is Nothing Then With .Shapes.AddShape(msoShapeOval, r.Left, r.Top, r.Width, r.Height) .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(0, 0, 0) .Line.Weight = 1 End With End If End With End Sub （SoulMan） 2020/06/15(月) 20:29 ---- SoulMan さん こんばんは ^^ こちらこそ、何時も済みません。 あえて、x様はおられなくても動くような気が しないでは有りませんが。。。^^;。m(_ _)m はい。 いまこちらもテストしてみました。 修正已前も動いていましたので、なにが原因 となっているのでしょうね、他にもマクロが あるとの事でしたので、そちらでしょうかね ちえこ さん にお聞きするしか無いかもしれ ませんね。m(_ _)m （隠居じーさん） 2020/06/15(月) 21:40 ---- >あえて、x様はおられなくても動くような気が あっははは、、ですよねぇ(^^; 同じときは再計算しませんものねぇ??? 何か勘違いしてたかな??? ありがとうございます。。。 流石ですね。。。せんせいm(__)m （SoulMan） 2020/06/15(月) 21:50 ---- 隠居じーさん様 SoulMan様 出来ました。 本チャン頑張ってみます。 （ちえこ） 2020/06/16(火) 09:33 ---- 隠居じーさん様 SoulMan様 実際のファイルでやってみた所、実行時エラー1004 アプリケーション定義またはオブジェクト定義エラーですと出てしまいました。 他のマクロが関係してますかね? 新規Bookの時は動いたのですが、ダメでした。 他のマクロも載せておいたほうがよろしいですかね? Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) '----------------------------------------------------------------------------------------------- Dim lngRow As Long ' 行INDEX If Target.Column <> 1 Or Target.Count > 1 Then Exit Sub lngRow = Target.Row ' 登録処理を呼び出す(引数は選択行) Call TOUROKU(lngRow) End Sub '----------------------------------------<< End of Source >>---------------------------------------- Sub main() Dim c As Range, sht As Worksheet For Each c In Sheets("data").Range("W2:W" & Rows.Count).SpecialCells(2) Do For Each sht In Worksheets If sht.Name = c.Value & "月" Then Intersect(Sheets("data").Range("AJ:AU"), c.EntireRow).Copy sht.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Exit Do End If Next sht Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = c.Value & "月" 'Sheets("data").Rows(1).Copy Worksheets(Worksheets.Count).Range("A4") Sheets("data").Range("AJ1:AU1").Copy Worksheets(Worksheets.Count).Range("A4") Loop Next c End Sub （ちえこ） 2020/06/16(火) 09:45 ---- こんにちは ^^ すみません、外出いたしておりました。 停止したプロシジャー名と コード、停止箇所等が、お解りでしたら こちらに貼り付けてやってください。 今現在［ちょい見では］?状態なので 今から、ちょっと見てみますね。。。 下のSub mainは同じシートモジュールにあるのでしょうか。 どこかで拝見したことがある様なないような。。。^^; 引き続き他の方の回答もお待ちくださいね。m(_ _)m （隠居じーさん） 2020/06/16(火) 11:19 ---- 以前質問しました。 ユーザーフォームで登録しています。 ↑のコードはmodule1に書いてあります。 ↑のコードも未完成でこちらも困っています。 中々一度では伝わらないですね。 宜しくお願いします。 （ちえこ） 2020/06/16(火) 12:00 ---- こんにちは ^^ あ、はい了解です で、エラーの件ですが、 1.どのマクロで発生していますか 2.黄色くなっているコードを教えて下さい 上記のマクロが有る事が直接の原因では無いかもしれません「内容によっては解りませんが」 一応疑似マクロ作りましたが問題なく動いています。。。m(_ _)m （隠居じーさん） 2020/06/16(火) 12:06 ---- If Not Intersect(.Range("F26,F27,F31"), .Range(myshap.TopLeftCell.Address, .Range(myshap.BottomRightCell.Address))) Is Nothing Then ↑この部分でエラーが出ます。 VLOOKUPで表示と同時に出ます。 （ちえこ） 2020/06/16(火) 12:16 ---- こんにちは ^^ 実際のシートの .Range("F26,F27,F31") 当たりのセル と 新規BOOKの同じアドレス、セルに何か相違点は有りません でしょうか。何かお気づきの点があれば教えて下さい。 その様なものは有りませんと云うエラーの様な気がいたしますので こちらでは、先ほどからテストするのですが、再現しません。? 今少し調べてみますね。m(_ _)m （隠居じーさん） 2020/06/16(火) 13:03 ---- こんにちは<(_ _)> ユーザーフォームで登録しています。 それも関係あるのでしょうかね? シートは発注書・list・dataの3つのシートで作っております。 dataのシートはユーザーフォームで入力し発注書の番号でVLOOKUPを使用しています。 宜しくお願いします。 （ちえこ） 2020/06/16(火) 13:15 ---- こんにちは ^^ ＞＞dataのシートはユーザーフォームで入力し発注書の番号でVLOOKUPを使用しています。 全く関係無いとは言い切れませんので。 推測しますのでVLOOKUPの数式をここにコピペしてみて下さい。 では、とりあえず、こちらのテスト環境を整えてみます。暫時御猶予を 出来れば簡単な3シートのフォーマットが解る、表形式をご提示いただけませんでしょうか 概略で、2‾3行分で結構ですので、^^;個人情報は。。きつねとか、たぬき等で代替してくださいね いまからuserformこさえてみます。m(_ _)m （隠居じーさん） 2020/06/16(火) 14:53 ---- こんにちは。 わざわざありがとうございます。 出来上がったら燃え尽きそうです。 ユーザーフォームのマクロコードです。 Option Explicit '=================================================================================================== Public g_swOK As Byte ' フォームで登録が押されたかを判定するスイッチ Public Sub TOUROKU(lngRow As Long) '----------------------------------------------------------------------------------------------- With FRM_USER ' 新規登録か判断 If ((lngRow = 1) Or (Cells(lngRow, 1).Value = "")) Then ' 見出しか未登録行の場合は新規登録と判断 lngRow = 0 .ComboBox5.Text = "" '会社名 .TXT_CODE.Text = "" ' 注文番号 .ComboBox2 = "" '注文 年 .ComboBox3 = "" '注文 月 .ComboBox4 = "" '注文 日 .ComboBox1 = "" '担当者 .TXT_hin1 = "" '品名1 .TXT_su1 = "" '数量1 .TextBox1 = "" '単価1 .TXT_hin2 = "" '品名2 .TXT_su2 = "" '数量2 .TextBox2 = "" '単価2 .TXT_hin3 = "" '品名3 .TXT_su3 = "" '数量3 .TextBox3 = "" '単価3 .TXT_hin4 = "" '品名4 .TXT_su4 = "" '数量4 .TextBox4 = "" '単価4 .TextBox6 = "" '品名5 .TXT_su5 = "" '数量5 .TextBox5 = "" '単価5 .ComboBox6 = "" '納期 年 .ComboBox7 = "" '納期 月 .ComboBox8 = "" '納期 日 .Text_ba = "" '納期場所 .ComboBox13 = "" '支払方法 ' .OptionButton1 = "" '口座振込 ' .OptionButton2 = "" '現金 ' .OptionButton3 = "" 'その他 .Text_si = "" '支払その他 .TextB1 = "" '備考1 .TextB2 = "" '備考2 .TextB3 = "" '備考3 .TextB4 = "" '備考4 .TextB5 = "" '備考5 .ComboBox10 = "" ' .ComboBox11 = "" ' .ComboBox12 = "" ' Else ' 既存行の場合は修正と判断 .ComboBox5.Text = Cells(lngRow, 2).Value ' 会社名 .TXT_CODE.Text = Cells(lngRow, 1).Value '注文番号 .ComboBox2.Text = Cells(lngRow, 3).Value ' 注文 年 .ComboBox3.Text = Cells(lngRow, 4).Value '注文 月 .ComboBox4.Text = Cells(lngRow, 5).Value '注文 日 .ComboBox1.Text = Cells(lngRow, 6).Value '担当者 .TXT_hin1.Text = Cells(lngRow, 7).Value '品名1 .TXT_su1.Text = Cells(lngRow, 8).Value '数量1 .TextBox1.Text = Cells(lngRow, 9).Value '単価1 .TXT_hin2.Text = Cells(lngRow, 10).Value '品名2 .TXT_su2.Text = Cells(lngRow, 11).Value '数量2 .TextBox2.Text = Cells(lngRow, 12).Value '単価2 .TXT_hin3.Text = Cells(lngRow, 13).Value '品名3 .TXT_su3.Text = Cells(lngRow, 14).Value '数量3 .TextBox3.Text = Cells(lngRow, 15).Value '単価3 .TXT_hin4.Text = Cells(lngRow, 16).Value '品名4 .TXT_su4.Text = Cells(lngRow, 17).Value '数量4 .TextBox4.Text = Cells(lngRow, 18).Value '単価4 .TextBox6 = Cells(lngRow, 19).Value '品名5 .TXT_su5.Text = Cells(lngRow, 20).Value '数量5 .TextBox5.Text = Cells(lngRow, 21).Value '単価5 .ComboBox6.Text = Cells(lngRow, 22).Value '納期 年 .ComboBox7.Text = Cells(lngRow, 23).Value '納期 月 .ComboBox8.Text = Cells(lngRow, 24).Value '納期 日 .Text_ba = Cells(lngRow, 25).Value '納期場所 .ComboBox13 = Cells(lngRow, 26).Value '支払方法 .Text_si = Cells(lngRow, 27).Value '支払3 .TextB1 = Cells(lngRow, 28).Value '備考1 .TextB2 = Cells(lngRow, 29).Value '備考2 .TextB3 = Cells(lngRow, 30).Value '備考3 .TextB4 = Cells(lngRow, 31).Value '備考4 .TextB5 = Cells(lngRow, 32).Value '備考5 .ComboBox10 = Cells(lngRow, 33).Value ' .ComboBox11 = Cells(lngRow, 34).Value ' .ComboBox12 = Cells(lngRow, 35).Value ' End If ' フォームを表示 g_swOK = 0 .Show ' 登録ボタンが押されていない場合は以降の処理はしない If g_swOK <> 1 Then Exit Sub ' 新規登録の場合は未登録行を探す If lngRow = 0 Then lngRow = 2 ' 会社列未登録を判定 Do While Cells(lngRow, 1).Value <> "" lngRow = lngRow + 1 Loop End If ' シート上に登録 ActiveSheet.Unprotect Cells(lngRow, 2).Value = Trim(.ComboBox5.Text) ' 会社名 Cells(lngRow, 1).Value = Trim(.TXT_CODE.Text) ' 注文番号 Cells(lngRow, 3).Value = Trim(.ComboBox2.Text) ' 注文 年 Cells(lngRow, 4).Value = Trim(.ComboBox3.Text) '注文 月 Cells(lngRow, 5).Value = Trim(.ComboBox4.Text) '注文 日 Cells(lngRow, 6).Value = Trim(.ComboBox1.Text) '担当者 Cells(lngRow, 7).Value = Trim(.TXT_hin1.Text) '品名1 Cells(lngRow, 8).Value = Trim(.TXT_su1.Text) '数量1 Cells(lngRow, 9).Value = Trim(.TextBox1.Text) '単価1 Cells(lngRow, 10).Value = Trim(.TXT_hin2.Text) '品名2 Cells(lngRow, 11).Value = Trim(.TXT_su2.Text) '数量2 Cells(lngRow, 12).Value = Trim(.TextBox2.Text) '単価2 Cells(lngRow, 13).Value = Trim(.TXT_hin3.Text) '品名3 Cells(lngRow, 14).Value = Trim(.TXT_su3.Text) '数量3 Cells(lngRow, 15).Value = Trim(.TextBox3.Text) '単価3 Cells(lngRow, 16).Value = Trim(.TXT_hin4.Text) '品名4 Cells(lngRow, 17).Value = Trim(.TXT_su4.Text) '数量4 Cells(lngRow, 18).Value = Trim(.TextBox4.Text) '単価4 Cells(lngRow, 19).Value = Trim(.TextBox6.Text) '品名5 Cells(lngRow, 20).Value = Trim(.TXT_su5.Text) '数量5 Cells(lngRow, 21).Value = Trim(.TextBox5.Text) '単価5 Cells(lngRow, 22).Value = Trim(.ComboBox6.Text) '納期 年 Cells(lngRow, 23).Value = Trim(.ComboBox7.Text) '納期 月 Cells(lngRow, 24).Value = Trim(.ComboBox8.Text) '納期 日 Cells(lngRow, 25).Value = Trim(.Text_ba.Text) '納期場所 Cells(lngRow, 26).Value = Trim(.ComboBox13.Text) '支払方法 ' Cells(lngRow, 26).Value = Trim(.OptionButton1.Caption) '口座振込 ' Cells(lngRow, 26).Value = Trim(.OptionButton2.Caption) '現金 ' Cells(lngRow, 26).Value = Trim(.OptionButton3.Caption) 'その他 Cells(lngRow, 27).Value = Trim(.Text_si.Text) '支払方法3 Cells(lngRow, 28).Value = Trim(.TextB1.Text) '備考1 Cells(lngRow, 29).Value = Trim(.TextB2.Text) '備考2 Cells(lngRow, 30).Value = Trim(.TextB3.Text) '備考3 Cells(lngRow, 31).Value = Trim(.TextB4.Text) '備考4 Cells(lngRow, 32).Value = Trim(.TextB5.Text) '備考5 Cells(lngRow, 33).Value = Trim(.ComboBox10.Text) ' Cells(lngRow, 34).Value = Trim(.ComboBox11.Text) ' Cells(lngRow, 35).Value = Trim(.ComboBox12.Text) ' ActiveSheet.Protect End With End Sub （ちえこ） 2020/06/16(火) 15:05 ---- こんにちは ^^ 怪しげなコード、発見しました。。。 ひょっとして。。。当該シートに保護がかかっているのではないでしょうか、 だとすると、オートシェープ、〇を書込めません。今から試して見ます。 （隠居じーさん） 2020/06/16(火) 15:17 ---- はい。 よくわからないのですが、保護がかかってしまって、どこの部分のコードを消せばいいのかわからずです。 dataシート A B C D E F C G H I J K L M 〜 AJ AK AL AM AN AO AP AQ AR AS AT AU 1 会社名 注文番号 注文年 注文月 注文日 品名 数量 単価 納品年 納品月 納品日 納品場所 支払方法 備考 〜 No. 内容 業者 番号 注文書 注文日 発行 要・不要 受領日 税込価格 支払日 備考 2 ああ 20001 2020 4 1 あ 1 100 2020 4 2 あああ 振込 1 3 いい 20002 2020 4 25 あ 1 200 2020 4 26 いいい 振込 2 4 ああ 20003 2020 4 27 い 1 100 2020 4 28 ううう 振込 3 5 うう 20004 2020 5 1 う 1 250 2020 5 2 いいい 振込 1 6 いい 20005 2020 5 24 あ 1 320 2020 5 25 あああ 振込 2 発注書シート V4=リストで注文番号を選んで、VLOOKUPで表示しています。 AJ26=IFERROR(IF(VLOOKUP($V$4,data!$A:$AI,24,FALSE)=0,"",VLOOKUP($V$4,data!$A:$AI,26,FALSE)),"") （ちえこ） 2020/06/16(火) 15:19 ---- こんにちは ^^ エラー番号、メッセージから推測すると、シートの保護とは違うようなので あまり、自信は無いのですが［エラーがダブりで起きている可能性も^^;］ とりあえず この〇を付けるシート名はどれでしょうか、発注書、ですかそれともlist? （隠居じーさん） 2020/06/16(火) 15:47 ---- 発注書です。 宜しくお願いします。 （ちえこ） 2020/06/16(火) 15:49 ---- 発注書シートモジュールの Private Sub Worksheet_Calculate() ↓ End Sub を下記の物と差し換えて下さい。で。。。お試しを。。m(_ _)m Private Sub Worksheet_Calculate() Me.Unprotect Static x As Variant If IsError(Me.Range("AJ26").Value) Then Exit Sub If x = Me.Range("AJ26").Value Then Exit Sub Select Case Me.Range("AJ26").Value Case 1 kk Me, Me.Range("F26") Case 2 kk Me, Me.Range("F27") Case 3 kk Me, Me.Range("F31") Case Else kk Me End Select x = Me.Range("AJ26").Value Me.Protect End Sub （隠居じーさん） 2020/06/16(火) 15:53 ---- 隠居じーさん様 やっぱりIf Not Intersect(.Range("F26,F27,F31"), .Range(myshap.TopLeftCell.Address, .Range(myshap.BottomRightCell.Address))) Is Nothing Then の部分がエラーで黄色くなります。 困りました。 （ちえこ） 2020/06/16(火) 16:01 ---- はい ^^ もう一度 下記の物と差し換えて試して見て下さい。 セルを移動するだけでイベントが起きている可能性がありますので、 推測の域を出ないのですが。一度止めてみました。(◎_◎;)。。。m(_ _)m Private Sub Worksheet_Calculate() Me.Unprotect Application.EnableEvents = False Static x As Variant If IsError(Me.Range("AJ26").Value) Then Exit Sub If x = Me.Range("AJ26").Value Then Exit Sub Select Case Me.Range("AJ26").Value Case 1 kk Me, Me.Range("F26") Case 2 kk Me, Me.Range("F27") Case 3 kk Me, Me.Range("F31") Case Else kk Me End Select x = Me.Range("AJ26").Value Me.Protect Application.EnableEvents = True End Sub （隠居じーさん） 2020/06/16(火) 16:09 ---- 有難うございます。 やってみましたが… 実行時エラーが出てしまいます。 （ちえこ） 2020/06/16(火) 16:19 ---- 失礼致しました、A列以外はすぐ抜けていました、関係なかったようですね。 複数ブック、複数シート、等を使用時に、どのシートのどのセルか、エクセル様 が理解不能になった時によく出るエラーなので、なにかお心当たり、とか、これ かも。。。みたいなものは御座いませんでしょうか。 新規ブックで動くのですから、何か必ず、原因は［相違点］あるはずです。 最近頭の中身が弱っていますので、考えてみます。←嘘つけ前からやろ。!はい、 済みませんm(_ _)m。 無理にとは申し上げませんが［必ず判明するとは言えませんので、ダメ元で^^;］ 各シートのマクロ、こちらにそのままアップもご考察ください。お役に立てず申し訳 有りません、懲りずに、他の方の回答もお待ちくださいね。でわでわ。。。m(_ _)m （隠居じーさん） 2020/06/16(火) 16:42 ---- エラーメッセージを省略せずに示してみては? （γ） 2020/06/16(火) 16:48 ---- Option Explicit '=================================================================================================== ユーザーフォームのマクロ Module1マクロ Public g_swOK As Byte ' フォームで登録が押されたかを判定するスイッチ Public Sub TOUROKU(lngRow As Long) '----------------------------------------------------------------------------------------------- With FRM_USER ' 新規登録か判断 If ((lngRow = 1) Or (Cells(lngRow, 1).Value = "")) Then ' 見出しか未登録行の場合は新規登録と判断 lngRow = 0 .ComboBox5.Text = "" '会社名 .TXT_CODE.Text = "" ' 注文番号 .ComboBox2 = "" '注文 年 .ComboBox3 = "" '注文 月 .ComboBox4 = "" '注文 日 .ComboBox1 = "" '担当者 .TXT_hin1 = "" '品名1 .TXT_su1 = "" '数量1 .TextBox1 = "" '単価1 .TXT_hin2 = "" '品名2 .TXT_su2 = "" '数量2 .TextBox2 = "" '単価2 .TXT_hin3 = "" '品名3 .TXT_su3 = "" '数量3 .TextBox3 = "" '単価3 .TXT_hin4 = "" '品名4 .TXT_su4 = "" '数量4 .TextBox4 = "" '単価4 .TextBox6 = "" '品名5 .TXT_su5 = "" '数量5 .TextBox5 = "" '単価5 .ComboBox6 = "" '納期 年 .ComboBox7 = "" '納期 月 .ComboBox8 = "" '納期 日 .Text_ba = "" '納期場所 .ComboBox13 = "" '支払方法 ' .OptionButton1 = "" '口座振込 ' .OptionButton2 = "" '現金 ' .OptionButton3 = "" 'その他 .Text_si = "" '支払その他 .TextB1 = "" '備考1 .TextB2 = "" '備考2 .TextB3 = "" '備考3 .TextB4 = "" '備考4 .TextB5 = "" '備考5 .ComboBox10 = "" ' .ComboBox11 = "" ' .ComboBox12 = "" ' Else ' 既存行の場合は修正と判断 .ComboBox5.Text = Cells(lngRow, 2).Value ' 会社名 .TXT_CODE.Text = Cells(lngRow, 1).Value '注文番号 .ComboBox2.Text = Cells(lngRow, 3).Value ' 注文 年 .ComboBox3.Text = Cells(lngRow, 4).Value '注文 月 .ComboBox4.Text = Cells(lngRow, 5).Value '注文 日 .ComboBox1.Text = Cells(lngRow, 6).Value '担当者 .TXT_hin1.Text = Cells(lngRow, 7).Value '品名1 .TXT_su1.Text = Cells(lngRow, 8).Value '数量1 .TextBox1.Text = Cells(lngRow, 9).Value '単価1 .TXT_hin2.Text = Cells(lngRow, 10).Value '品名2 .TXT_su2.Text = Cells(lngRow, 11).Value '数量2 .TextBox2.Text = Cells(lngRow, 12).Value '単価2 .TXT_hin3.Text = Cells(lngRow, 13).Value '品名3 .TXT_su3.Text = Cells(lngRow, 14).Value '数量3 .TextBox3.Text = Cells(lngRow, 15).Value '単価3 .TXT_hin4.Text = Cells(lngRow, 16).Value '品名4 .TXT_su4.Text = Cells(lngRow, 17).Value '数量4 .TextBox4.Text = Cells(lngRow, 18).Value '単価4 .TextBox6 = Cells(lngRow, 19).Value '品名5 .TXT_su5.Text = Cells(lngRow, 20).Value '数量5 .TextBox5.Text = Cells(lngRow, 21).Value '単価5 .ComboBox6.Text = Cells(lngRow, 22).Value '納期 年 .ComboBox7.Text = Cells(lngRow, 23).Value '納期 月 .ComboBox8.Text = Cells(lngRow, 24).Value '納期 日 .Text_ba = Cells(lngRow, 25).Value '納期場所 .ComboBox13 = Cells(lngRow, 26).Value '支払方法 ' .OptionButton1 = Cells(lngRow, 26).Value '口座振込 ' .OptionButton2 = Cells(lngRow, 26).Value '現金 ' .OptionButton3 = Cells(lngRow, 26).Value 'その他 .Text_si = Cells(lngRow, 27).Value '支払3 .TextB1 = Cells(lngRow, 28).Value '備考1 .TextB2 = Cells(lngRow, 29).Value '備考2 .TextB3 = Cells(lngRow, 30).Value '備考3 .TextB4 = Cells(lngRow, 31).Value '備考4 .TextB5 = Cells(lngRow, 32).Value '備考5 .ComboBox10 = Cells(lngRow, 33).Value ' .ComboBox11 = Cells(lngRow, 34).Value ' .ComboBox12 = Cells(lngRow, 35).Value ' End If ' フォームを表示 g_swOK = 0 .Show ' 登録ボタンが押されていない場合は以降の処理はしない If g_swOK <> 1 Then Exit Sub ' 新規登録の場合は未登録行を探す If lngRow = 0 Then lngRow = 2 ' 下請業者列未登録を判定 Do While Cells(lngRow, 1).Value <> "" lngRow = lngRow + 1 Loop End If ' シート上に登録 ActiveSheet.Unprotect Cells(lngRow, 2).Value = Trim(.ComboBox5.Text) ' 会社名 Cells(lngRow, 1).Value = Trim(.TXT_CODE.Text) ' 注文番号 Cells(lngRow, 3).Value = Trim(.ComboBox2.Text) ' 注文 年 Cells(lngRow, 4).Value = Trim(.ComboBox3.Text) '注文 月 Cells(lngRow, 5).Value = Trim(.ComboBox4.Text) '注文 日 Cells(lngRow, 6).Value = Trim(.ComboBox1.Text) '担当者 Cells(lngRow, 7).Value = Trim(.TXT_hin1.Text) '品名1 Cells(lngRow, 8).Value = Trim(.TXT_su1.Text) '数量1 Cells(lngRow, 9).Value = Trim(.TextBox1.Text) '単価1 Cells(lngRow, 10).Value = Trim(.TXT_hin2.Text) '品名2 Cells(lngRow, 11).Value = Trim(.TXT_su2.Text) '数量2 Cells(lngRow, 12).Value = Trim(.TextBox2.Text) '単価2 Cells(lngRow, 13).Value = Trim(.TXT_hin3.Text) '品名3 Cells(lngRow, 14).Value = Trim(.TXT_su3.Text) '数量3 Cells(lngRow, 15).Value = Trim(.TextBox3.Text) '単価3 Cells(lngRow, 16).Value = Trim(.TXT_hin4.Text) '品名4 Cells(lngRow, 17).Value = Trim(.TXT_su4.Text) '数量4 Cells(lngRow, 18).Value = Trim(.TextBox4.Text) '単価4 Cells(lngRow, 19).Value = Trim(.TextBox6.Text) '品名5 Cells(lngRow, 20).Value = Trim(.TXT_su5.Text) '数量5 Cells(lngRow, 21).Value = Trim(.TextBox5.Text) '単価5 Cells(lngRow, 22).Value = Trim(.ComboBox6.Text) '納期 年 Cells(lngRow, 23).Value = Trim(.ComboBox7.Text) '納期 月 Cells(lngRow, 24).Value = Trim(.ComboBox8.Text) '納期 日 Cells(lngRow, 25).Value = Trim(.Text_ba.Text) '納期場所 Cells(lngRow, 26).Value = Trim(.ComboBox13.Text) '支払方法 Cells(lngRow, 27).Value = Trim(.Text_si.Text) '支払方法3 Cells(lngRow, 28).Value = Trim(.TextB1.Text) '備考1 Cells(lngRow, 29).Value = Trim(.TextB2.Text) '備考2 Cells(lngRow, 30).Value = Trim(.TextB3.Text) '備考3 Cells(lngRow, 31).Value = Trim(.TextB4.Text) '備考4 Cells(lngRow, 32).Value = Trim(.TextB5.Text) '備考5 Cells(lngRow, 33).Value = Trim(.ComboBox10.Text) ' Cells(lngRow, 34).Value = Trim(.ComboBox11.Text) ' Cells(lngRow, 35).Value = Trim(.ComboBox12.Text) ' ActiveSheet.Protect End With End Sub dataのシート Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) '----------------------------------------------------------------------------------------------- Dim lngRow As Long ' 行INDEX If Target.Column <> 1 Or Target.Count > 1 Then Exit Sub lngRow = Target.Row ' 登録処理を呼び出す(引数は選択行) Call TOUROKU(lngRow) End Sub '----------------------------------------<< End of Source >>---------------------------------------- Sub main() Dim c As Range, sht As Worksheet For Each c In Sheets("data").Range("W2:W" & Rows.Count).SpecialCells(2) Do For Each sht In Worksheets If sht.Name = c.Value & "月" Then Intersect(Sheets("data").Range("AJ:AU"), c.EntireRow).Copy sht.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False Exit Do End If Next sht Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = c.Value & "月" 'Sheets("data").Rows(1).Copy Worksheets(Worksheets.Count).Range("A4") Sheets("data").Range("AJ1:AU1").Copy Worksheets(Worksheets.Count).Range("A4") Loop Next c End Sub 発注書のシート Option Explicit Private Sub Worksheet_Calculate() Me.Unprotect Application.EnableEvents = False Static x As Variant If IsError(Me.Range("AJ26").Value) Then Exit Sub If x = Me.Range("AJ26").Value Then Exit Sub Select Case Me.Range("AJ26").Value Case 1 kk Me, Me.Range("F26") Case 2 kk Me, Me.Range("F27") Case 3 kk Me, Me.Range("F31") Case Else kk Me End Select x = Me.Range("AJ26").Value Me.Protect Application.EnableEvents = True End Sub Sub kk(ByVal MySh As Worksheet, Optional ByVal r As Range) Dim myshap As Shape With MySh For Each myshap In .Shapes If Not Intersect(.Range("F26,F27,F31"), .Range(myshap.TopLeftCell.Address, .Range(myshap.BottomRightCell.Address))) Is Nothing Then myshap.Delete End If Next If Not r Is Nothing Then With .Shapes.AddShape(msoShapeOval, r.Left, r.Top, r.Width, r.Height) .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(0, 0, 0) .Line.Weight = 1 End With End If End With End Sub これで全部になります。 宜しくお願いします。 （ちえこ） 2020/06/16(火) 16:54 ---- ＞＞実際のファイルでやってみた所、実行時エラー1004 ＞＞アプリケーション定義またはオブジェクト定義エラーですと出てしまいました。 黄色反転箇所 ↓ If Not Intersect(.Range("F26,F27,F31"), .Range(myshap.TopLeftCell.Address, .Range(myshap.BottomRightCell.Address))) Is Nothing Then だそぉです。 ^^;。。。なんとなく。わかってきたよぉな。。。m(_ _)m いや、そんな気がするだけです。。。m(_ _)m 今しばらく御猶予を （隠居じーさん） 2020/06/16(火) 16:59 ---- 前に出ているのと同じですか その時のシートの保護状況は? Shapeは具体的に何ですか? 具体的に見ていけば手掛かりはありそうです。 最後に提示されたコードの保護解除などの 位置が適切では無いように思われます。 問題に直接関係しませんが。 （γ） 2020/06/16(火) 17:05 ---- 入力規則があると、それがshapeと判定されるが、 shp.TopLeftCellはエラーになるようですね。 （γ） 2020/06/16(火) 17:13 ---- Yさま 隠居じーさんさま 前のも含めて全部載せてみました。 解除方法は暗証番号などはないので、そのまま解除できます。 オートシェイプは白抜きの黒丸です。 dataのユーザーフォームもエラーになってしまって登録できなくなりました… （ちえこ） 2020/06/16(火) 17:15 ---- ＞＞dataのユーザーフォームもエラーになってしまって登録できなくなりました… w (◎_◎;) 。。。すみません。 こちらは どのような。。 エラー番号、メッセージ、停止箇所のコード、等お願いいたします。 （隠居じーさん） 2020/06/16(火) 17:25 ---- 隠居じーさん様 If Not Intersect(.Range("F26,F27,F31"), .Range(myshap.TopLeftCell.Address, .Range(myshap.BottomRightCell.Address))) Is Nothing Then またこちらです。↑ フォームは開くのですが登録を押すとエラーです。 実行時エラー1004と出ます。 すみません。 ほんとにすみません （ちえこ） 2020/06/16(火) 17:30 ---- エラーになったとき、 イミディエイトウインドウに ?myshap.Type と入力して、返ってくる結果を教えて下さい。 （γ） 2020/06/16(火) 17:37 ---- ?myshap.Name もお願いします。 （γ） 2020/06/16(火) 17:39 ---- いえいえ ^^ こちらこそ、勉強させていただいております。 γさんからの強力なフォローもあり、有難う御座います。 （隠居じーさん） 2020/06/16(火) 17:45 ---- If myshap.Type = msoAutoShape Then などの限定をつけると図形だけが削除の対象となるものと思います。 # ちょっと出掛けます。 （γ） 2020/06/16(火) 17:50 ---- こんばんは! わちきの駄作コードのせいで皆様には大変ご迷惑をおかけしております。。です。。。どうもすみません。。m(__)m どうもShapeを制限していないのが原因の様なので、、 書きたいのは、、楕円ですので、、消すのも、、楕円としました。。。 一応、、全コードを載せておきます。。。 どうでしょうか???上手く行きます様に!!!ぱんぱん Option Explicit Private Sub Worksheet_Calculate() Static x As Variant If IsError(Me.Range("AJ26").Value) Then Exit Sub If x = Me.Range("AJ26").Value Then Exit Sub Select Case Me.Range("AJ26").Value Case 1 kk Me, Me.Range("F26") Case 2 kk Me, Me.Range("F27") Case 3 kk Me, Me.Range("F31") Case Else kk Me End Select x = Me.Range("AJ26").Value End Sub Sub kk(ByVal MySh As Worksheet, Optional ByVal r As Range) Dim myshap As Shape With MySh For Each myshap In .Shapes If myshap.Type = msoAutoShape Then If myshap.AutoShapeType = msoShapeOval Then If Not Intersect(.Range("F26,F27,F31"), .Range(myshap.TopLeftCell.Address, .Range(myshap.BottomRightCell.Address))) Is Nothing Then myshap.Delete End If End If End If Next If Not r Is Nothing Then With .Shapes.AddShape(msoShapeOval, r.Left, r.Top, r.Width, r.Height) .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(0, 0, 0) .Line.Weight = 1 End With End If End With End Sub （SoulMan） 2020/06/16(火) 19:54 ---- どうも横入り失礼しました。 なにか、保護しているようでしたので、いったん保護解除して作業、そのご再保護でしょうか。 Private Sub Worksheet_Calculate() Static x As Variant If IsError(Me.Range("AJ26").Value) Then Exit Sub If x = Me.Range("AJ26").Value Then Exit Sub Me.Unprotect Select Case Me.Range("AJ26").Value Case 1 kk Me, Me.Range("F26") Case 2 kk Me, Me.Range("F27") Case 3 kk Me, Me.Range("F31") Case Else kk Me End Select x = Me.Range("AJ26").Value Me.Protect End Sub （γ） 2020/06/16(火) 21:47 ---- Y様 SoulMan様 隠居じーさん様 色々とご迷惑をおかけしております。m(__)m 明日会社でやってみますね。 保護はこのデーターが簡単な見本でネットのユーザーフォームから入力する場合、というコードを引用して作成しました。 保護は必要ないんですが、勝手に保護が入ってしまう、dataが出来てしまったんです。 それに色づけと肉付けして今の状態です。 どのタイミングで保護がかかるかが分かっておりません。 色々、試行錯誤して下さって本当に申し訳ないです。 保護がかかる以外は、使い勝手はいいと思うのですが… 書式も決まっており、発注書加工する事は出来ず、今の現状になっております。 月別に振り分けされた後に保護が掛かっていたと思います。 こんな私のために皆さんで一緒に考えてくれてとても嬉しい気持ちと申し訳ない気持ちで一杯です。 本当にありがとうございます。 （ちえこ） 2020/06/16(火) 21:59 ---- こんばんは! コントロール出来ていないのは問題ですね(^^; 取り敢えず↓これは消してください。。。 ActiveSheet.Protect プロテクト・・・・保護・・・です。 これを消せば保護は掛かりません。。。 （SoulMan） 2020/06/16(火) 22:13 ---- 重なり衝突しました。折角書いたので。 どこで保護かかっているかわからないそうですが、 Public Sub TOUROKU(lngRow As Long) の最後で ActiveSheet.Protect としているじゃないですか。 不要ならとればいいし、その前にやっているUnprotectもとってください。 頂いたコードであっても、きちんと中身をよく読んで、 自分のものとしておかないといけないと思います。 それが回答を下さったかたへの礼儀です。 （γ） 2020/06/16(火) 22:15 ---- 明日会社で試されるとのことですので簡潔なアドバイスを、、、いくつか。。。 コントロール出来ていなコードで仕事をされていることに驚きですが、 それはそれとして、、今回を機に是非、Helpの使い方を身に付けることをお勧めします。 コードのわからないところにカーソルをおいてF1を押すとHelpが出ます。 Helpが出てたら参考コードを試してもいいですし、、オブジェクト プロパティなどなど ネットで質問するよりもはるかに有意義な情報があります。 (青く反転しているところクリック) 勿論、ネットにはネットのいいところがありますからそれを否定するものではありません。 Helpもちょいちょい間違っていることもある(笑) 要は、ある程度の基礎知識、、それ以前に使い方をマスターすることです。 Helpは、基礎の基礎、、何はなくても、、が多いですけど(^^; これはなんだ?と思ったら、、選択してF1、、、メンバーを調べる、、定数を調べる。。。 みたいなことをしていると思わぬ発見があったりで楽しいものです。 特に図形は記録されないのでHelpの出番ですよね。 もう、、コードなんて書きたくない。。。と思うこともありますけど。。。。 少なくともわからないままコードを走らしちゃだめです。。。 コードを覚えるのではなくて、、書き方というかぁ、、調べ方を身に付けることです。 それが出来るようになれば、、わからないままコードを走らせる、、、なんてことはまずありえません。。。 簡潔と言いながら長くなってしまいしました。。。くれぐれも気分を悪くなされません様に。。。頑張ってください。 では、、では、、おやすみなさいzzzzzzzzzzzzzzzz （SoulMan） 2020/06/16(火) 23:05 ---- SoulManさま Yさま 隠居じーさんさま 出来ました!! 保護も消して、満足です。 月毎にシートに振り分ける、作業を改めて質問したいと思います。 本当にご協力ありがとうございました。 （ちえこ） 2020/06/17(水) 09:01... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/202006/20200605172751.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97057 documents and 608302 words.
訪問者：