既存のVBA記述に機能を追加したい

このQ&Aのポイント
  • 既存のVBA記述に機能を追加したいと思っています。テキストボックスが空の場合に限り、貼り付けコマンドが実行されますが、データがある場合も上書きするようにしたいと考えています。
  • 私は、このサイトでアドバイスをいただいたVBAに機能追加を行いたいと思っています。特に、テキストボックスが空である場合に限り、貼り付けコマンドが実行されるようにしたいと考えています。
  • 私は、VBAの既存コードに機能を追加したいと考えています。具体的には、テキストボックスが空の場合にのみ、貼り付けコマンドを実行するようにしたいと思っています。また、データがある場合でも、上書きすることができるようにしたいと考えています。
回答を見る
  • ベストアンサー

既存のVBAに機能を追加させたい

先日、このサイトでアドバイスをいただきましたが「ありがとうございます」、更に能力をアップできればと思っています。アドバイスをお願いします。 [やりたいこと] 既存のVBA記述に機能を追加したい。「このサイトでアドバイスをいただいたVBAに機能追加」 現在、テキストボックスが空「データなし時」の場合に限り、貼り付けコマンドが実行されますが、「データありの場合」は、表示されたダイアログの「はい」を押しても上書きされません。今回(機能を追加)、データありの場合も「貼り付け(上書き)」を実行させたいと思っています。 ・フォーム:フォーム10 ・コマンドボタン:コマンド10 ・テキストボックス:テキスト10 Private Sub コマンド10_Click()   Me!テキスト10.SetFocus   If Not IsNull(Me!テキスト10) Then     If MsgBox("すでに入力されてます。上書しますか?", vbYesNo) = vbNo Then       Me!コマンド10.SetFocus     End If   Else     If MsgBox("クリップボードのデータを貼り付けますか", vbYesNo) = vbYes Then       DoCmd.RunCommand acCmdPaste     End If   End If End Sub [再アドバイスのお願いの背景] 当初、新規追加データのみを対象「上書き事故懸念」にしていましたが、既存データの変更要が散見されたこと。それと、実際に運用してみて動作が確り「強固」していることが確認できたこと。以上の二点です。宜しくお願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • chayamati
  • ベストアンサー率41% (254/607)
回答No.2

下記のように6行目と7行目が抜けています。 Private Sub コマンド10_Click() Me!テキスト10.SetFocus If Not IsNull(Me!テキスト10) Then If MsgBox("すでに入力されてます。上書しますか?", vbYesNo) = vbNo Then Me!コマンド10.SetFocus Else DoCmd.RunCommand acCmdPaste End If Else If MsgBox("クリップボードのデータを貼り付けますか", vbYesNo) = vbYes Then DoCmd.RunCommand acCmdPaste End If End If End Sub ------------------------------------------------------------------------------------- これはこれでよいとして、直接テキスト10へ書き込み、またはペーストでよいのでは! >当初、新規追加データのみを対象「上書き事故懸念」にしていましたが、 >既存データの変更要が散見されたこと。 >実際に運用してみて動作が確り「強固」していることが確認できたこと。 これらの懸念は上記で解消又は軽減されるとは考えられません テーブルデザインで、ルックアップ、インデックスで重複無し、値要求等の設定 フォームデザインで、 編集ロック、タブストップ(はい、いいえ) オートナンバーのフィールドは変更等は元々できませんのでフォーム上に配置する必要はありません。

eokwave
質問者

お礼

chayamati レベル12様へ ありがとうございました。シンプルな作り込みでアドバイスをいただきました「運用の結果は良好でした」。早速、訂正が必要なデータベースへ記述しました。書き込み禁止の記述とアドバイスの記述を使い分けて行きたいと思っています。「上書き事故を100%防ぐことは難しいからです(特に私に於いては・・・。)」 有難うございました。

その他の回答 (3)

  • piroin654
  • ベストアンサー率75% (692/917)
回答No.4

「実行時エラー ’429’」のほかに何かコメントが表示されると 思うのですが。たとえば、 「実行時エラー'429'ActiveXコンポーネントはオブジェクトを作成できません」 のようなものですか。 一応、こちらで見当をつけてのべてみます。 https://okwave.jp/qa/q9317356.html のところで、 次に、フォームのコード表を表示し、ツールから参照設定を クリックします。するとたぶん    Microsoft Forms 2.0 Object Library にチェックが入った状態で表示されていると思います。 のところがあるとおもいますが、これを確認してみてください。 Microsoft Forms 2.0 Object Library が参照設定されていないとこのようなエラーか、あるいは 定義違反のエラーが表示されるとおもいます。 もし、参照設定されていないなら、もう一度 https://okwave.jp/qa/q9317356.html での設定の方法を確認してみてください。ただし この設定は一つのファイルにしか適用されません。 ファイルが違えばまた設定しないとエラーがでます。

  • piroin654
  • ベストアンサー率75% (692/917)
回答No.3

以下のようにしてみてください。ロジックはコメントを たどればわかると思います。なお、データがあっても 変更する場合はいきなりクリップボードのデータを 貼り付けるのではなく、確認をしてYesならば貼り付け、 Noならばテキストボックスにフォーカスがあたったまま 何もしません。 Private Sub コマンド10_Click()   Me!住所.SetFocus   'データが入力されている場合   If Not IsNull(Me!テキスト10) Then     '入力されているデータを変更しない場合     If MsgBox("すでに入力されてます。データを変更しますか?", vbYesNo) = vbNo Then       Me!コマンド10.SetFocus     '入力されているデータを変更する場合     Else       'クリップボードのデータを貼り付ける場合は貼り付け、       '貼り付けをしない場合はフォーカスはそのまま       If MsgBox("クリップボードのデータを貼り付けますか", vbYesNo) = vbYes Then         DoCmd.RunCommand acCmdPaste       End If     End If   'データが入力されていない場合   Else     'クリップボードのデータを貼り付ける場合     If MsgBox("クリップボードのデータを貼り付けますか", vbYesNo) = vbYes Then       DoCmd.RunCommand acCmdPaste     End If   End If End Sub クリップボードのデータを鵜呑みにして貼り付けるのは あまりいい方法とはいえません。むしろ誤データの貼り付け につながる恐れさえあります。 https://okwave.jp/qa/q9317356.html でも述べた通り、クリップボードのデータの型の確認、それから 付け加えるならば、もしクリップボードのデータがテキストならば その内容の確認などをして貼り付けを行なうのがベストだと 思います。 そこで以前の回答のコードを少し変更してしたものを載せておきます。 これは、メッセージボックスでクリップボードの内容を確認するように なっています。このコードの構築で必要な手続きは以前のところで 述べています。普通だったらかならずこちらの方法をとると思いますが。 Private Sub コマンド5_Click()   Dim dObj As New DataObject   Me!住所.SetFocus   '住所に入力されている場合   If Not IsNull(Me!住所) Then     If MsgBox("すでに入力されてます。上書しますか?", vbYesNo) = vbNo Then       Me!名前.SetFocus     Else       dObj.GetFromClipboard       'クリップボードのデータがテキストの場合       'メッセージボックスの「No」を押した場合はそのまま住所にフォーカスをおいたままになる       If dObj.GetFormat(1) Then         If MsgBox("クリップボードにテキストデータがあります。データを貼り付けますか?" & vbNewLine & "********** テキスト内容 **********" & vbNewLine & dObj.GetText, vbYesNo) = vbYes Then           Me!住所 = dObj.GetText         End If       End If     End If   '住所が未入力の場合   Else     dObj.GetFromClipboard     'クリップボードのデータがテキストの場合     'メッセージボックスの「No」を押した場合はそのまま住所にフォーカスをおいたままになる     If dObj.GetFormat(1) Then       If MsgBox("クリップボードにテキストデータがあります。データを貼り付けますか?" & vbNewLine & "********** テキスト内容 **********" & vbNewLine & dObj.GetText, vbYesNo) = vbYes Then         Me!住所 = dObj.GetText       End If       'クリップボードのデータがテキストでない場合、あるいはデータがない場合     Else       MsgBox ("クリップボードにテキストデータはありません")     End If   End If   Set dObj = Nothing End Sub VBAコードを使用するというのは複雑なロジックの構築、 便利な機能を利用するということも上記のようにすれば できますが、それよりもロジックを正確に構築する、 あるいは構築したロジックが目指す目的に叶うように なっているかを確認できる、というのも使用するという メリットです。

eokwave
質問者

お礼

piroin654 レベル13様へ ありがとございました。皆様「アドバイス側の方」へ必要な情報を十分にお伝えできていなかったことが改めて分かりました。前回、アドバイス頂きました、書き込み禁止のVBA「要望アドバイスでした」は全てのオブジェクトの該当するロケーションに記述致しました。尚、一部のデータベースで訂正要が多くでたこともあり、再アドバイスの形でお願い致しました。勿論、訂正の不必要なデータベースも多くありますので、そちらは「上書き禁止のVBA」のまま利用します「上書き事故を100%防ぐことは無理ですから」。お陰様でVBAが少しですが分かりそうな気がしてきました。ありがとうございました「感謝の副次効果になりました」。ありがとうございました。

eokwave
質問者

補足

piroin654 レベル13様へ アドバイスを有難うございます。取り急ぎテストの結果をご報告いたします。私のスキル不足で上手く動かない様です。ご指導をお願い致します。下記の「※記述7行目の名前がよく分かっていないです」 [実施結果] ・データが無い時はいきなり「実行時エラー ’429’」が表示 ・データがある時は「すでに入力されています。上書しますか?」→(はい)→「実行時エラー ’429’」 [オブジェクト] コマンドボタン名=コマンド121 テキストボックス名:解決策 [記述内容] Private Sub コマンド121_Click()   Dim dObj As New DataObject   Me!解決策.SetFocus   '住所に入力されている場合   If Not IsNull(Me!解決策) Then     If MsgBox("すでに入力されてます。上書しますか?", vbYesNo) = vbNo Then       Me!コマンド121.SetFocus ※ここの名前の設定名先がイマイチ分かっていないです。     Else       dObj.GetFromClipboard       'クリップボードのデータがテキストの場合       'メッセージボックスの「No」を押した場合はそのまま住所にフォーカスをおいたままになる       If dObj.GetFormat(1) Then         If MsgBox("クリップボードにテキストデータがあります。データを貼り付けますか?" & vbNewLine & "********** テキスト内容 **********" & vbNewLine & dObj.GetText, vbYesNo) = vbYes Then           Me!解決策 = dObj.GetText         End If       End If     End If   '住所が未入力の場合   Else     dObj.GetFromClipboard     'クリップボードのデータがテキストの場合     'メッセージボックスの「No」を押した場合はそのまま住所にフォーカスをおいたままになる     If dObj.GetFormat(1) Then       If MsgBox("クリップボードにテキストデータがあります。データを貼り付けますか?" & vbNewLine & "********** テキスト内容 **********" & vbNewLine & dObj.GetText, vbYesNo) = vbYes Then         Me!解決策 = dObj.GetText       End If       'クリップボードのデータがテキストでない場合、あるいはデータがない場合     Else       MsgBox ("クリップボードにテキストデータはありません")     End If   End If   Set dObj = Nothing End Sub 以上、宜しくお願いします。

回答No.1

> アドバイスをお願いします。 とのことですから、アドバイスを。 入力されているかどうか?の条件分岐に 「Yesなら貼り付け」を加えればOKです。 現状は「Noなら[コマンド10]にフォーカスを渡してスルー」なので、 そこにElse分岐してやるだけです。 正直、どうなんでしょう? と思ってしまいますね。

eokwave
質問者

お礼

tsubu-yuki レベル10様へ ありがとうございました。アドバイスをいただきましたのに即追従できない状況「低スキル」でお手数をお掛けしました。少しでも反応できる様に最低限のコマンドと「利用ロケーション」は覚えたいと思います。ありがとうございました。

eokwave
質問者

補足

tsubu-yuki レベル10様へ 私、VBAの知識が全くのところブアでございます。申し訳ございませんが、アドバイス頂いた「条件分岐に「Yesなら貼り付け」を加えればOKです。」の記述追加を教えて下さい。見よう見まねの「コピペ」記述で試しましたが完成には程遠い状態です。宜しくお願いします。

関連するQ&A

  • access setfocusについて

    いつもお世話になっております。 いろいろ調べたのですが行き詰っておりまして ご教授お願いします。 下記記述でsetfocusでエラーになってしまいます。 Private Sub コマンド_Click() If IsNull(Me.テキストボックスコントロール名) Then MsgBox "未入力です" Me.テキストボックスコントロール名.SetFocus End If テキストボックスの処理記述 End Sub https://www.moug.net/tech/acvba/0030005.html こちらを参考にしました。 よろしくお願いします。

  • VBAの書き方を教えてください。

    Access2010を使用しています。 フォーム:ログインにID、PASSのテキストBOXを設け、フォーム:メニューのコマンドボタンをID別に使用不可にしています。問題は、メニューからさらに製品仕様書の一覧フォームを開き、指定の製品の詳細フォームを開くのですが、詳細フォームにログインで入力したIDを使用し、使用不可コマンドボタンを作りたいのです。 ログインボタン Dim Res If IsNull(Me.ID) Then MsgBox "IDを入力してください" Me.ID.SetFocus Exit Sub End If If IsNull(Me.パスワード) Then MsgBox "パスワードを入力してください" Me.パスワード.SetFocus Exit Sub End If Res = DLookup("パスワード", "talogin", "ID='" & Me.ID & "'") If IsNull(Res) Then MsgBox "該当するIDはありません。正しいIDを入力してください。" Me.ID.SetFocus Exit Sub End If If Res = Me.パスワード Then DoCmd.OpenForm "メニュー" '----ID,pass合致でフォームを開く。 Forms!メニュー!ログイン名 = Me.ID Else MsgBox "パスワードが異なります。", vbOKOnly + vbCritical Me.パスワード.SetFocus End If End sub ログインボタンで、テーブルtaEnabledを参照。不可リストに書き込んだボタン名のみ、使用不可にする。 メニュー画面にログイン名を表示。 Private Sub Form_Open(Cancel As Integer) Dim AID As Long Dim Var As Variant AID = Nz(DLookup("権限ID", "taLogin", "ID ='" & Forms!ログイン!ID & "'"), 0) For Each Var In Split(DLookup("不可リスト", "taEnabled", "権限ID =" & AID), ",") Me.Controls(Var).Enabled = Flase Next Var End Sub この後、フォーム:メニューに設置の各帳票・単表フォームを開いた時に、再度IDを使用し、表示したフォーム内のコマンドボタンを使用不可にしたいので、皆様のお力をお貸し下さい。

  • VBAに「maqBox」を追加したい

    検索結果フォーム「未来」を開くフォーム「マスター」に配した、コマンドボタンのイベントに下記の記述「OKWaveで過去にアドバイス頂いた」をしています。この記述に「("指定したレコードはありません")」を表示させたいと思います。WEBを参照したりしてやってみましたが上手く出来ませんでした。 ツール:Access2007 フォーム名:未来 Private Sub コマンド27_Click() If Me.CurrentRecord < Me.Recordset.RecordCount Then DoCmd.GoToRecord acDataForm, Me.Name, acNext End If End Sub [やってみたこと「VBA知識なし」] Private Sub コマンド27_Click() If Me.CurrentRecord < Me.Recordset.RecordCount Then DoCmd.GoToRecord acDataForm, Me.Name, acNext End If   MsgBox ("指定したレコードはありません") End Sub 上記の書込だと検索結果のレコードの数だけ移動時にメッセージが出る。 以上ですが、宜しくお願いします。

  • vba ユーザーフォームについて

    勉強のためにvb勉強中です。エクセルのユーザーフォームについて質問です。 コンボボックス 01 02 のどちらかを選択すると、テキストに入力した数字は、01を選択したら11行、02を選択したら12行に転記できるようにしたいのですが、if文を使うのだろうと思うのですが、教えていただけないでしょうか。 私が途中まで作成した載せておきます。よろしくお願い申し上げます。 Private Sub CommandButton1_Click() Dim rc As Long Dim retu As Long Dim Ctrl As Control If Me.txtComboBox1.Value = "" Then MsgBox "社員名を選択してください!", vbOKOnly Me.txtComboBox1.SetFocus Exit Sub End If rc = MsgBox("件数を入力しますか?", vbYesNo) If rc = vbYes Then MsgBox "実行する" Else MsgBox "中止しました" Exit Sub End If retu = Cells(3, Columns.Count).End(xlToLeft).Column + 1 Cells(3, retu).Value = Me.txtComboBox1.Value ←社員を選択 Cells(4, retu).Value = Me.txtsuzuki.Value  ←売れた件数 Cells(5, retu).Value = Me.txttoyota.Value  ←売れた件数 Cells(6, retu).Value = Me.txthonnda.Value   ←売れた件数 For Each Ctrl In Me.Controls If Ctrl.Name Like "txt*" Then Ctrl.Value = "" End If Next Ctrl End Sub また、テキストボックスに数字だけ入力して、プルダウン選択してないとエラ~メッセージも出るようにしたいです...

  • 以下のVBAについて

    Option Compare Database Option Explicit Private Sub バックアップ開始_Click() Dim strBaseName As String Dim strFileName As String If IsNull(Me.バックアップ日付) = True Or Len(Me.バックアップ日付) = 0 Then MsgBox "バックアップ日付をyyyymmdd形式で入力してください。", vbOKOnly + vbCritical, "" Me.バックアップ日付.SetFocus Exit Sub End If strBaseName = "C:\Data\在庫管理.mdb" strFileName = "C:\Backup\" & Format(Me.日付, "yyyymmdd") & "StockData.mdb" If Dir(strFileName) <> "" Then If MsgBox(strFileName & Chr(13) & "は存在します。" & Chr(13) & _ "上書しますか?", vbYesNo + vbQuestion, "") = vbNo Then Exit Sub End If End If On Error GoTo LBL_ERROR FileCopy strBaseName, strFileName MsgBox "バックアップが完了しました。", vbInformation, "" LBL_EXIT: Exit Sub LBL_ERROR: Resume LBL_EXIT End Sub 上記のVBAでバックアップを行いたいのですが、フォルダ等も設定しているの実行されません。上記の文に間違いがあるのでしょうか? ソフトはAccessです。

  • Access VBA

    Access2003を使用しています。 単純な質問かもしれませんがよろしくお願いします。 ログイン画面を作成しておりログイン自体はできたのですが、ログインしたときに ログイン画面を自動的に閉じたいのですが、うまくいきません。 現在の仕様では、ログイン画面(frm_ログイン)とメイン画面(frm_main)があり ログインに成功するとメイン画面が開くようになっています。 ーー以下VBAコードーー Private Sub rogin_Click() Dim a If IsNull(Me.[UserName]) Then MsgBox "IDが未入力です" Me.[UserName].SetFocus ElseIf IsNull(Me.[password]) Then MsgBox "パスワードが未入力です" Me.[password].SetFocus Else a = DLookup("パスワード", "tbl_ユーザー", "ユーザー名='" & Me.[UserName] & "'") If IsNull(a) Then MsgBox "該当する ユーザー名 は存在しません" Me.[UserName].SetFocus ElseIf StrComp(a, Me.[password], vbBinaryCompare) = 0 Then On Error GoTo Err_rogin_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "frm_main" DoCmd.OpenForm stDocName, , , stLinkCriteria Else MsgBox "パスワードが違います" Me.[password].SetFocus End If End If Exit_rogin_Click: Exit Sub Err_rogin_Click: MsgBox Err.Description Resume Exit_rogin_Click End Sub ーー以上ーー 長くなって申し訳ないのですが、どのようにすればログイン後にログイン画面(frm_ログイン)を閉じるようにできるのでしょうか? よろしくお願いします。

  • Setfocus について

    お世話になります。 Access2000でVBAを書いています。 ユーザがテキスト1に商品番号を入れます。ここで商品番号が8桁指定なので Dim Keta As Intger Keta = Len(テキスト1) If Keta <> 8 Then Msgbox"???" テキスト1.SetFocus End If と書きました。 しかし、SetFocusが効きません。他のテキスト(例えば、テキスト2)などにフォーカスを飛ばすことは テキスト2.SetFocus でいくのですが、自分のところに フォーカスを戻すのはなにか特別なコマンドがあるのですか? ご指導、お願いします。

  • ユーザーフォーム データ消去の時の処理

    環境:Excel2002です ユーザーフォームのテキストボックスの入力チェックをしています Rem**************** Rem TextBox5 Check Rem**************** Private Sub TextBox5_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If Len(Me.TextBox5.Text) = 0 Then '未入力Check If IsNumeric(Me.TextBox5.Text) = False Then '数値入力Check MsgBox "数値で入力してください", _ vbExclamation, "納品書作成ツール" Me.TextBox5.SetFocus Exit Sub End If MsgBox "入力してください", _ vbExclamation, "納品書作成ツール" Me.TextBox5.SetFocus Exit Sub End If Me.TextBox5.Text = Format(Me.TextBox5.Text, "#,##0") End Sub 入力したデータを消去して Enterキーを押すか、マウスでクリックした時のいずれでも Len(Me.TextBox5.Text) = 0 と認知されて "数値で入力してください"のメッセージが表示されてしまいます このメッセージが出ないようにするにはどうしたらいいのでしょうか ご教示願います

  • VBAで教えてください。

    データがないときはExitSubしたいのですが、何処に記述すれば良いでしょうか? Sub 削除() Dim i As Long If MsgBox("データを削除します。よろしいですか?", vbYesNo) = vbYes Then Sheets("リスト").Select i = 5 Do Until i = 200 If Cells(i, 5).Value = Sheets("マスタ登録").Range("D5") Then Cells(i, 1).EntireRow.Delete End If i = i + 1 Loop Else Exit Sub End If End Sub

  • VBAでユーザーフォーム上に参照したファイルを開きたいのですが…

    EXCEL2003 SP3での質問です。 ユーザーフォームをVBAで作成中です。 主な機能は、対象月をコンボBOXで選択させた上で、 データ元とインプット先のファイルをテキストBOXに参照し、 実行ボタンクリックでデータ元からインプット先の該当月シートに データをコピーするといった感じです。 (データ元の該当シート内データを全てコピー&ペースト) 取り込み以降の処理はVBAを使用せずに作成しようと考えています。 質問は、取込みたいファイルの参照後の「ファイルを開いてデータをコピーする」処理がうまくいかず、 どのようにしたらよいか教えて頂けますでしょうか。 現在、以下のように記述していますが、 CommandButton3_Click()の部分の処理が分からずファイルが開けません。ご教授ください。 Private Sub CommandButton1_Click() With Application.FileDialog(msoFileDialogFilePicker) .Filters.Clear .Filters.Add "テキスト", "*.csv;*.txt", 1 If .Show = 0 Then Exit Sub Me.TextBox1.Text = .SelectedItems(1) End With End Sub Private Sub CommandButton2_Click() With Application.FileDialog(msoFileDialogFilePicker) .Filters.Clear .Filters.Add "テキスト", "*.csv;*.txt", 1 If .Show = 0 Then Exit Sub Me.TextBox2.Text = .SelectedItems(1) End With End Sub Private Sub CommandButton3_Click() Dim file_name As String If TextBox1.Text = "" Then MsgBox "ファイルが指定されていません", vbInformation ElseIf TextBox1.Text = "" Then file_name = TextBox1.Text = "" Shell "Workbooks.OpenText TextBox1.Value " End If End Sub Private Sub CommandButton4_Click() yesno = MsgBox("保存後、ファイルを閉じます。終了していいですか?", vbYesNo + vbQuestion, "Reportの終了") If yesno = vbYes Then ActiveWorkbook.Save ActiveWorkbook.Close Else End If End Sub

専門家に質問してみよう