- ベストアンサー
エクセル VBA
VBA内で、そのVBAの実行を制御することは可能でしょうか? 下のようなコードを作ったのですが、 Sub 承認書作成() Dim ws0 As Worksheet, ws1 As Worksheet, r1 As Range Dim i As Long Dim nyuryoku(), chikuseki() Set ws0 = Worksheets("承認書作成") Set ws1 = Worksheets("顧客データ") Set ws2 = Worksheets("業者コード") Set ws3 = Worksheets("承認通知書") Worksheets("顧客データ").Select Range("テーブル1[[#Headers],[NO.]]").Select Selection.End(xlToRight).Select Selection.End(xlDown).Select Selection.ListObject.ListRows.Add AlwaysInsert:=False Range("B7").Select nyuryoku = Array("b5", "d5", "f5", "h5", "j5", "l5", "n5", "p5", "b6", "d6", "f6", "h6", "j6", "l6", "n6", "p6", "b4", "d4") '転記したいセルの位置 chikuseki = Array("0", "1", "5", "6", "8", "9", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "53", "54") '転記先の列のオフセット値 Set r1 = ws1.Range("f" & Rows.Count).End(xlUp).Offset(0) 'データ蓄積セル For i = 0 To UBound(nyuryoku) r1.Offset(0, chikuseki(i)).Value = ws0.Range(nyuryokui)).Value '入力 Next MsgBox "入力完了" Dim lRowNum As Long '転記先となる行番号を求める lRowNum = ws1.Cells(Rows.Count, "b").End(xlUp).Row '転記 ws3.Cells(6, "d").Value = ws1.Cells(lRowNum, "j").Value ws3.Cells(17, "g").Value = ws1.Cells(lRowNum, "c").Value ws3.Cells(22, "g").Value = ws1.Cells(lRowNum, "l").Value ws3.Cells(22, "ac").Value = ws1.Cells(lRowNum, "ab").Value Set ws0 = Nothing Set ws1 = Nothing End Sub ここに、 If call Macro1 then call 承認書作成 '上のマクロです Else: Msgbox"中止" 「Macro1を実行しないと承認書作成マクロを実行できない」 という コードを組み込みたいのですが、うまくいきません。 VBA内に同じVBAを組み込むことは不可能なのでしょうか?
- kinoyasuko
- お礼率43% (14/32)
- オフィス系ソフト
- 回答数7
- ありがとう数6
- みんなの回答 (7)
- 専門家の回答
質問者が選んだベストアンサー
#02です >自分なりに上のマクロに組み込んでみたのですが、うまく作動してくれません。 とのことですが、まず新規のシートの標準モジュールシートに#02に書いたマクロをそのまま貼り付けて、Macro2を実行してみてください。次にMacro1を実行してから、もう一度Macro2を実行してください 簡単なマクロですから、まず動作を理解してからご自身のマクロに組み込んだ方がよいですよ。 想像が入りますが Dim psw As Boolean Sub Macro1() psw = True ’ kinoyasukoさんのMacro1の記述 End Sub Sub 承認書作成() If psw Then MsgBox "実行可能" ’ kinoyasukoさんの承認書作成マクロの記述 Else MsgBox "中断" End If End Sub のようにすれば動くと思います
その他の回答 (6)
- n-jun
- ベストアンサー率33% (959/2873)
#3です。 >Macro1をクリックした時のみ、承認通知書のマクロが実行されるようにしないといけなくて。 >Macro1のボタンを押せば承認書作成マクロが実行できる、押さないとできない。 シートに置いたコマンドボタンで承認書作成のマクロを実行したいと 言う事ですか?
お礼
ありがとうございました、解決しました! また何かの機会があれば宜しくお願い致します。
補足
そうです、ボタンが2個ありMacro1のボタンを押さないと、 承認書作成マクロのボタンを押せないようにしたいです。 承認書作成ボタンを押すたびにリセットされ 承認書作成マクロを実行したあとに、承認書作成ボタンを2度連続で押そうとしてもMacro1のボタンをおしてからでないと実行できないようなしくみにしたいのです。 説明が分かりにくくすみません、お願い致します。
- imogasi
- ベストアンサー率27% (4737/17068)
次ぎのステップへ実行したという情報を後のステップへ伝えるには、1変数(FLG)を定義しておいて、まず前もって適当な場所(色々処理により場合場合ガある)で初期化(例えばFLG=”N")しておいて、問題のステップを通ったら、FLG="Y"にして、通過したかどうかをチェックするステップでIf FLG="Y" Then (OKルーチン)のようにする。 (そして利用直後・用済み後にFLG="N"にする。)フラグ(旗を立てる)といって、プログラマの常識的手法です。 ただ変数FLGは、どのスッテップでも保持されている、PUBLIC変数などで無いと、別モジュールに行って、システムで初期化されるようでは困るので注意が必要です。 ーー コードを長々書いて質問し、回答者に読解させるのも良いが、初めにやりたいことの要点を文章で書くのが、回答者の負担や、理解不十分を減らすことになることを考慮されたい。本件では 「プログラムのあるステップを通ったかどうか、後のステップで判別したい」ぐらいかな。
お礼
ありがとうございました、解決しました! また何かの機会があれば宜しくお願い致します。
補足
>コードを長々書いて質問し、回答者に読解させるのも良いが、初めにやりたいことの要点を文章で書くのが、回答者の負担や、理解不十分を減らすことになることを考慮されたい。 説明不足ですみません。 質問が至らないのに回答して頂いて、ありがとうございます。 しかしVBA初心者なもので、ぜんぜん理解できないです、、、 すみません、勉強する限りですね。
- papayuka
- ベストアンサー率45% (1388/3066)
単純に Macro1 → 承認書作成 の順番で必ずマクロを実行させたいって事じゃないみたいですね。 Macro1が一度も実行されて無い状態では「承認書作成」を実行出来ないようにしたいって事? シェアウェアでパスワードを入れてないとダメ見たいな感じ? 例えば、Macro1を実行したら隠しシートとか既存シートの未使用セルとかに何らかのフラグを立てて、「承認書作成」マクロはそれを見て実行させるとか、、、 大した仕組みじゃないけど、例えば '---------------------------------------------------------------------- Sub Macro1() Do s = Application.InputBox("パスワードは?", "入力", Type:=1) If s = False Then MsgBox "終了します", vbCritical, "キャンセル" ' ThisWorkbook.Close savechanges:=False Exit Sub End If Loop Until s = 123456 MsgBox "OK", vbInformation, "パス解除" Worksheets(1).Range("IV1").Value = True ThisWorkbook.Save End Sub '---------------------------------------------------------------------- Sub 承認書作成() If Not Worksheets(1).Range("IV1").Value Then MsgBox "Macro1でパスワードを入れてね", vbInformation, "要求" Exit Sub End If MsgBox "承認書作成" End Sub
お礼
ありがとうございました、解決しました! また何かの機会があれば宜しくお願い致します。
補足
ありがとうございます。 私にとっては複雑ですが、うまくいきました! しかしどこに承認書作成マクロを組み込めばよいかが分かりませんでした。。 パスワードというのは少し大げさすぎまして、 Macro1のボタンを押せば承認書作成マクロが実行できる、押さないとできない。 といったものを作らないといけないのです。 分からない用語は勉強して、参考させて頂きます。
- n-jun
- ベストアンサー率33% (959/2873)
>「Macro1を実行しないと承認書作成マクロを実行できない」 >Macro1を実行していない場合は実行できない様にしたいのです。 承認書作成のマクロを実行した際に、まずMacro1を呼び出して実行後に 以降を続けて実行すればいいのでは? 承認書作成のマクロを実行する際に、Macro1が必ず実行されると まずい場合があるのなら別ですが。
補足
>承認書作成のマクロを実行する際に、Macro1が必ず実行されると まずい場合があるのなら別ですが。 まさにそうです。 Macro1をクリックした時のみ、承認通知書のマクロが実行されるようにしないといけなくて。 承認通知書のマクロに、承認通知書のマクロを組み込むと、どうしてもループしてしまいます。 なので、そんなことできるわけない、と教えてくだされば違う方法を考えてみます。
- zap35
- ベストアンサー率44% (1383/3079)
「ご参考まで」ですが、こんな制御方法も考えられます。 ただしプログラムスイッチをFalseに戻すタイミングは考える必要がありますが… Dim psw As Boolean Sub Macro1() psw = True End Sub Sub Macro2() If psw Then MsgBox "実行可能" Else MsgBox "実行不可" End If End Sub
補足
迅速なご回答ありがとうございます。 自分なりに上のマクロに組み込んでみたのですが、うまく作動してくれません。 Macro1とは質問で提示したものでよろしいでしょうか? せっかくアドバイス頂いたのに、VBA初心者なものですみません。
- hana-hana3
- ベストアンサー率31% (4940/15541)
Sub 承認書作成() call Macro1 Dim ws0 As Worksheet, ws1 As Worksheet, r1 As Range : : ではいけないのですか?
お礼
ありがとうございました、解決しました! また何かの機会があれば宜しくお願い致します。
補足
迅速なご回答ありがとうございます。 すみません、説明不足でした。 承認書作成マクロに制御をつけたいのですが、 Macro1を実行していない場合は実行できない様にしたいのです。 Ifの後にcallがどうしても入らないもので・・
関連するQ&A
- エクセル VBA データ入力
こんにちは、はじめまして。 エクセル・VBA初心者です。 会社に入って3ヶ月になります。 同じファイル内で、入力用シートから 違うシートに表としてデータを転送するため、 本や今まで作ったものを参考にして下のようなVBAを作成したのですがうまくいきません。 Sub 転記() Dim ws0 As Worksheet, ws1 As Worksheet, chikuseki As Range Dim nyuryoku() Set ws0 = Worksheets("Worksheet1") Set ws1 = Worksheets("Worksheet2") nyuryoku = Array("b3", "d3", "f3", "h3") '転記したいセルの位置 Set chikuseki = ws1.Range("f", "g", "k", "q" & Rows.Count).End(xlUp).Offset(1) 'データ蓄積セル For i = 0 To UBound(nyuryoku) chikuseki.Offset(0, i).Value = ws0.Range(nyuryoku(i)).Value ws0.Range(nyuryoku(i)).MergeArea.ClearContents Next masgbox "入力完了" End Sub 十何個あるデータを転送する場合、フォームから入力した方が簡単なのでしょうか? また、表にデータを転記し、そのなかのデータのいくつかを別の表に転記することは、一度の操作で可能ですか? 今週中に仕上げろと言われたので急いでいます、 どうかよろしくお願いします。 質問がまとまっていなくてわかりにくければ申し訳ないです。
- ベストアンサー
- オフィス系ソフト
- エクセルのVBAの記述について
VBAの記述についてなのですが、 Sub filter() Dim gyo As Long Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Set ws1 = Worksheets("データ") Set ws2 = Worksheets("チーム") Application.ScreenUpdating = False ws2.Range("A4:BH30").Clear gyo = ws1.Range("A65536").End(xlUp).Row ws1.Activate With ws1.Range(Cells(4, 1), Cells(gyo, 6)) .AutoFilter Field:=1, Criteria1:="A" .SpecialCells(xlCellTypeVisible).Copy ws2.Range("A4") Selection.AutoFilter End With Application.ScreenUpdating = True End Sub ならプログラムははしるのですが、 14行目を .SpecialCells(xlCellTypeVisible).Copy ws2.Range(Cells(4, 1)) だと 「実行時エラー 1004 Rangeメソッドは失敗しました Worksheet オブジェクト」 とでるのですが、出来ないのでしょうか? Cells(4, 1)の1のところを変数にして変えていきたいのですが、よい方法はありますか。 よろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- ExcelのVBAについてです。シート1と2を作成
ExcelのVBAについてです。シート1と2を作成し、シート1にバーコードまたはキーボードで入力します。シート1は入力専用かつ入力した分の早見表で、実際にはシート2に転記仕訳して、シート3以降に表を作成したいです。使い方はシート1に入力またはシート2をタップまたはクリックすると入力(画面)になります。以前の質問の回答を参考に必要最低限に改良しています。パッと見で構いません、何か不具合は見付からないでしょうか? '///Sheet1/// Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim time7 As Range For Each time7 In Target If time7.Column = 1 Then time7.Offset(0, 4).Value = Format(Now, "Short Time") & vbCrLf & _ Format(Now, "yyyy/mm/dd hh:nn:ss AM/PM") End If Application.EnableEvents = False Application.EnableEvents = True Next time7 '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 ws2.Range("A3:H3").Value = ws1.Range("A3:H3 ").Value End Sub Private Sub Worksheet_Activate() ' ' 新規行挿入 ' ' Worksheets("Sheet2").Range("3:3").Insert Sheets("Sheet1").Range("H3").Select ActiveCell.FormulaR1C1 = "5" Sheets("Sheet1").Range("E3").Select Selection.ClearContents Dim str_Left As String 'セルE4に文字列、セルH4に数字を予め入れておくこと。 str_Left = Left(Cells(4, 5), Cells(4, 8)) MsgBox str_Left & vbCrLf & " " & "OKボタンを押してください!" Sheets("Sheet1").Range("A3").Select Dim se_r As String se_r = Application.InputBox("バーコードを入力してください") Select Case se_r Case "False" MsgBox "キャンセルされました" Case "" MsgBox "空欄が入力されました" Case Else Range("A3").Value = se_r End Select End Sub ' ///Sheet2/// Private Sub Worksheet_Activate() Dim Emp(1 To 300) As String Dim msg As String Dim i, i2, Cnt As Integer Dim N_In As Variant For i = 3 To 3 If IsEmpty(Cells(i, 1).Value) = False Then 'ここで空欄判定 Worksheets("Sheet1").Range("3:3").Insert '対象セルアドレスを改行処理 End If '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Dim st1, s, i3 As Long Dim Bst As Range Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 st1 = ws1.Cells(Rows.Count, "E").End(xlUp).Row 'A列の最終行を設定する s = 3 For i3 = 3 To st1 Set Bst = ws2.Columns("E").Find(What:=ws1.Cells(i3, "E"), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) シート間のE列を比較 If Bst Is Nothing Then '比較して無い場合は、下記を実行 ws1.Cells(s, "A") = ws1.Cells(i3, "A") '追加する文字を転記する。(コード) s = s + 1 End If Next i3 Next i '(1)シートを変数にセット Dim ws1_ As Worksheet Set ws1_ = Worksheets("Sheet1") ws1_.Activate End Sub
- ベストアンサー
- その他(プログラミング・開発)
- ExcelのVBAについて(勉強中のです。)
ExcelのVBAについて(勉強中のです。) ここからコード3以降に入力したコードを抜き出してデータ表を作成しそれを保存するコードを作成したいです。例えばCSV形式にするとか? データ表は1日分の表示で、保存して週間や月間または統計データまでを視野にいれています。今回は保存する所です。。 利用しやすい状態と保存形式で、よろしくお願いします。データは生活記録みたいなものです。何したどうしたどうなった? ※大分分岐する予定で、作成中であり、今回はコードの整理は不要です。 '///Sheet1/// Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim time7 As Range For Each time7 In Target If time7.Column = 1 Then time7.Offset(0, 4).Value = Format(Now, "Short Time") & vbCrLf & _ Format(Now, "yyyy/mm/dd hh:nn:ss AM/PM") End If Application.EnableEvents = False Application.EnableEvents = True Next time7 '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 ws2.Range("A3:H3").Value = ws1.Range("A3:H3 ").Value End Sub Private Sub Worksheet_Activate() ' ' 新規行挿入 ' ' Worksheets("Sheet2").Range("3:3").Insert Sheets("Sheet1").Range("H3").Select ActiveCell.FormulaR1C1 = "5" Sheets("Sheet1").Range("E3").Select Selection.ClearContents Dim str_Left As String 'セルE4に文字列、セルH4に数字を予め入れておくこと。 str_Left = Left(Cells(4, 5), Cells(4, 8)) MsgBox str_Left & vbCrLf & " " & "OKボタンを押してください!" Sheets("Sheet1").Range("A3").Select Dim se_r As String se_r = Application.InputBox("バーコードを入力してください") Select Case se_r Case "False" MsgBox "キャンセルされました" Case "" MsgBox "空欄が入力されました" Case Else Range("A3").Value = se_r End Select End Sub ' ///Sheet2/// Private Sub Worksheet_Activate() Dim Emp(1 To 300) As String Dim msg As String Dim i, i2, Cnt As Integer Dim N_In As Variant For i = 3 To 3 If IsEmpty(Cells(i, 1).Value) = False Then 'ここで空欄判定 Worksheets("Sheet1").Range("3:3").Insert '対象セルアドレスを改行処理 End If Next i '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") ws1.Activate End Sub
- 締切済み
- その他(プログラミング・開発)
- VBA(エクセル)で教えて下さい。開いていないBOOKの貼り付け
VBA(エクセル)で教えて下さい。開いていないBOOKのシートを開いているBOOKのシートに貼り付けで、開いているBOOKから開いていないBOOK名を指定したいのですが、 現在開いているエクセルです。 SHEETS(Type)のRANGE(A1)に閉じているBOOK名を入力します。 SHEETS(In)に閉じているBOOKのSHEETSを貼り付けたいのですが、 Ex = Sheets("Type").Range("A1") が無いと閉じているEx.xlsを貼り付けます。 このExと言うBOOK以外も多々コピーしたいのですが、どのように書けば良いか分からず、 是非、教えて下さい。 Sub a1() Dim wsSrc As Worksheet, WS As Worksheet Dim PasteR As Range Dim x As Long Sheets("In").Select Cells.Select Selection.Delete Shift:=xlUp Range("A1").Select 'If Worksheets(1).Name = "STEP1" Then ' Worksheets(1).Activate ' Cells.ClearContents ' Else 'Worksheets.Add(Before:=Worksheets(1)).Name = "一覧" 'End If Ex = Sheets("Type").Range("A1") Set wsSrc = ActiveSheet Workbooks.Open "C:\WINDOWS\デスクトップ\test\Ex.xls" For Each WS In Worksheets x = WS.Range("A1").CurrentRegion.Rows.Count If WS.Index = 1 Then Set PasteR = wsSrc.Range("A1") Else Set PasteR = wsSrc.Range("A65536").End(xlUp).Offset(1) End If WS.Range(WS.Cells(1, 1), WS.Cells(x, 44)).Copy PasteR Set PasteR = Nothing Next ActiveWorkbook.Close False Set wsSrc = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
- Excel VBA 連番印刷
昨日以下の質問をさせていただいた者です。 http://okwave.jp/qa/q8349562.html こちらで教えていただいた以下のコードに、 J2のセルに連番を振るコードを付け足したいと思い、 同じくこちらのサイトの過去の履歴にあった以下コードを参考にとやってみているのですが、 Next で指定された変数の参照が無効です。と言われてしまいます… 印刷部数の指定はいらず、sheet印刷のJ2セルに1から始まる連番を振りたいのです。 どのように修正をしたらいいのかご教示願います。 Sub Sample4() Dim i As Long, endRow1 As Long, endRow2 As Long, myArea1 As Range, myArea2 As Range Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet Set wS1 = Worksheets("DB") Set wS2 = Worksheets("印刷") Set wS3 = Worksheets("Sheet3") endRow1 = wS1.Cells(Rows.Count, "A").End(xlUp).Row Range(wS1.Cells(1, "A"), wS1.Cells(endRow1, "A")).AdvancedFilter Action:=xlFilterInPlace, unique:=True wS1.Range("A:A").Copy wS3.Range("A1") wS1.ShowAllData For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row If endRow2 > 9 Then Range(wS2.Cells(10, "B"), wS2.Cells(endRow2, "H")).ClearContents Range(wS2.Cells(10, "J"), wS2.Cells(endRow2, "J")).ClearContents End If wS1.Range("A1").AutoFilter field:=1, Criteria1:=wS3.Cells(i, "A") wS2.Range("B6") = wS3.Cells(i, "A") Set myArea1 = Range(wS1.Cells(2, "B"), wS1.Cells(endRow1, "H")).SpecialCells(xlCellTypeVisible) Set myArea2 = Range(wS1.Cells(2, "I"), wS1.Cells(endRow1, "I")).SpecialCells(xlCellTypeVisible) myArea1.Copy wS2.Activate ActiveSheet.Range("B10").Select Selection.PasteSpecial Paste:=xlPasteValues myArea2.Copy wS2.Activate ActiveSheet.Range("J10").Select Selection.PasteSpecial Paste:=xlPasteValues endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row 'Range(wS2.Cells(1, "A"), wS2.Cells(endRow2, "J")).PrintOut Next i wS1.AutoFilterMode = False wS3.Cells.Clear End Sub 連番印刷のコード Sub NumberPrint() Dim idx As Integer Dim res res = Application.InputBox("印刷部数を入力してください", Type:=1) If res > 0 Then For idx = 1 To res Range("AW3").Value = idx ActiveSheet.PrintOut Next idx End If End Sub
- ベストアンサー
- Excel(エクセル)
- エクセルVBA,シート間転記でエラー1004
皆様宜しくお願いします。 以下の記述で 「実行時エラー1004アプリケーション定義 またはオブジェクト定義のエラーです」が 出てきます。 やりたい作業としては「週入力」シートの D5セルから下に入力されている内容を 「転記」シートの同じセル範囲へ転記したいです。 現在、転記先開始位置としてD5セルを決め打ちしています。 D行は固定ですが 列は変更になる可能性があるので ゆくゆく変数で書きたいと思っています。 以前はfor next で1行ずつ転記していてたのですが データが多すぎて時間がかかるので すこしでも時間短縮できればと 思いコードをあれこれ考えています。 どうかよろしくお願いします。 Sheets("週入力").Select Dim aa As Long 'A行の最終取得 aa = Range("A" & Rows.Count).End(xlUp).Row Dim 人数 As Long '変数「人数」を定義 人数 = aa - 4 Dim wsデータ As Worksheet Dim ws結果 As Worksheet Set wsデータ = ActiveWorkbook.Worksheets("週入力") Set ws結果 = ActiveWorkbook.Worksheets("転記") ws結果..Range(Cells(5, "D"), Cells(人数 + 5 - 1, "D")) =ws結果.Range(Cells(5, "D"), Cells(人数 + 5 - 1, "D")).Value
- ベストアンサー
- Excel(エクセル)
- ExcelのVBAについて(再掲)
ExcelのVBAについて(再掲) 以下のシートは作成中(勉強中)のものです。いずれは私的に実用しようと思っています。。 さて、質問ですが、「シート1のA3に入力、手動でシート2に移動自動で転記し、手動でシート1に移動し、また入力する」という単純動作を目的に作成しています。問題点は沢山ありますが、例えば『シート1の時間列が何かの変更で書き換えられてしまう』、『沢山書いていくと分かりますが、途中で行削除を行うと、時間列に削除行分の時間記録が下向きに書き込まれる』などです。他にもあると思っていますが、(1)この問題はなぜ発生するのか?(2)修正案としてはどの様な例があるか? 等をお聞きしたいです。細々と問題はあると思っていますので、その様な問題点もお聞きしたいです。 よろしくお願いします! '///Sheet1/// Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim time7 As Range For Each time7 In Target If time7.Column = 1 Then time7.Offset(0, 4).Value = Format(Now, "Short Time") & vbCrLf & _ Format(Now, "yyyy/mm/dd hh:nn:ss AM/PM") Application.EnableEvents = False Application.EnableEvents = True End If Next time7 Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") ws2.Range("A3:H3").Value = ws1.Range("A3:H3 ").Value End Sub Private Sub Worksheet_Activate() Application.Goto ActiveSheet.Range("A3"), True Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove Sheets("Sheet1").Range("H3").Select ActiveCell.FormulaR1C1 = "5" Sheets("Sheet1").Range("E3").Select Selection.ClearContents Dim str_Left As String 'セルE4に文字列、セルH4に数字を予め入れておくこと。 str_Left = Left(Cells(4, 5), Cells(4, 8)) MsgBox str_Left & vbCrLf & " " & "OKボタンを押してください!" Sheets("Sheet1").Range("A3").Select End Sub ' ///Sheet2/// Private Sub Worksheet_Activate() Application.Goto ActiveSheet.Range("A3"), True Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove Sheets("Sheet2").Range("A3").Select End Sub
- ベストアンサー
- その他(プログラミング・開発)
- EXCEL2010エラーVBA
下記を実行するとエラーになりEXCEL2010が終了してしまいます。 fDebug:0 offset00009391 がエラーメッセージです。 何が原因でしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet Dim rg As Range Dim r As Variant Dim c As Long Dim hanni1 As Range Dim atai As Range Set ws = Worksheets("あああ") Set rg = Worksheets("コード").Range("A1:B10") r = ws.Cells(Rows.Count, 1).End(xlUp).Row Set hanni1 = ws.Range(Cells(2, 2), Cells(r, 3)) Set atai = ws.Range(Cells(2, 3), Cells(r, 3)) atai = Application.VLookup(hanni1, rg, 2, False) End Sub
- ベストアンサー
- その他(プログラミング・開発)
- VBAエクセルにて開いてないエクセルシートを開いてるシートに所得
お世話になります。 「同じフォルダー内にBOOKが2つ有ります。1つ(AK.xls)を立上げて もう1つの(EX.xls)を立上げずに、EX.xls内のSheet1をコピーして AK.xlsのシート(STEP1)に貼り付けようとしています。」 どうしてもエラーが出てしまいます。 何方か、分かる方教えて下さい。 また記述して戴ければもっと助かります。 エラーは”1004”EX.xlsが見つかりません。と出てしまいます。 Sub ST() Dim wsSrc As Worksheet, WS As Worksheet Dim PasteR As Range Dim x As Long Sheets("STEP1").Select Cells.Select Selection.Delete Shift:=xlUp Range("A1").Select Set wsSrc = ActiveSheet Workbooks.Open "EX.xls" For Each WS In Worksheets x = WS.Range("A1").CurrentRegion.Rows.Count If WS.Index = 1 Then Set PasteR = wsSrc.Range("A1") Else Set PasteR = wsSrc.Range("A65536").End(xlUp).Offset(1) End If WS.Range(WS.Cells(1, 1), WS.Cells(x, 44)).Copy PasteR Set PasteR = Nothing Next ActiveWorkbook.Close False Set wsSrc = Nothing End Sub デバックでは Workbooks.Open "EX.xls"この部分が黄色になります。 是非、回答を宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
お礼
End IFのまえに、 psw = false を入れてみたら解決しました!ありがとうございました。 また何かの機会があれば宜しくお願い致します。
補足
ありがとうございます! 目的の働きをしてくれました! 調べてみたのですが、Boolean型というものでしょうか? この場合、Macro1を実行させると、「psw」がエクセルを終了するまで有効になっているのですが、 (表現の仕方が間違っていたらすみません。完璧には理解できていないです。) 承認書作成マクロの実行毎にこの動作をさせることはできないですか?