Visual Basic

VBA 追加処理の記述を教えてください。 お世話になります。マクロの初心者です、稚拙な部分はご容赦ください。 下記マクロを実行すると、元データが複数のファイルに分割されます。 追加作業としては、①シートの保護 出来上がった全ファイルのシートは１つ(シート名：『Sheet1』のみ)のA列～H列とJ列は保護され『I列』と『K列』は 保護されない(PWは、【9753】)。かつオートフィルタ設定でオートフィルタの操作は可能。 ②ファイルの種類は、CSVでファイルを作成希望。 自動で作成したく(今は手動で毎週100件作成)、ご教示の程お願い致します。 下記に対象リンク先と記述を記します。 リンク先 https://www.helpforest.com/excel/emv_sample/ex100010.htm ------------------------------------------------------------------------------- SubSample() DimMacroBAsWorksheet'このブックのシート DimWb_DataAsWorkbook'1.分割元ブック DimWb_newAsWorkbook'分割データ保存ブック DimWsAsString'2.分割元シート名 DimPathAsString'3.分割データ保存先 DimC_GroupAsString'4.グループ対象列 DimGroupNameAsString'グループ名（ブック名） DimC_CopyAsString'5.コピーデータ右端列 DimYMDAsString'6.保存ブック日付の表示形式 DimPSWAsString'7.読み取りパスワード DimR_DataAsInteger'データの行番号 DimKoAsInteger'グループの件数 SetMacroB=ThisWorkbook.Worksheets(1)'このブックのシート SetWb_Data=Workbooks(MacroB.Range("C11").Value)'分割元のブック名 Ws=MacroB.Range("C12") Path=MacroB.Range("C13")&"\" C_Group=MacroB.Range("C14") C_Copy=MacroB.Range("C15") YMD=MacroB.Range("C16") PSW=MacroB.Range("C17") IfYMD=""Then YMD="" Else YMD=Format(Date,YMD) EndIf R_Data=2'データの開始行 Application.ScreenUpdating=False Do Wb_Data.Activate Worksheets(Ws).Range(Cells(1,1),Cells(1,C_Copy)).Copy'1行目の項目名コピー Workbooks.Add ActiveSheet.PasteRange("A1")'新規ブックに貼り付け SetWb_new=ActiveWorkbook Wb_Data.Activate GroupName=Cells(R_Data,C_Group) Ko=WorksheetFunction.CountIf(Columns(C_Group),GroupName)'グループの件数を算出 Range(Cells(R_Data,"A"),Cells(R_Data+Ko-1,C_Copy)).Copy'グループ件数分コピー Wb_new.Activate ActiveSheet.PasteRange("A2")'新規ブック項目の下に貼り付け ActiveSheet.Columns.AutoFit ActiveSheet.UsedRange.Borders.LineStyle=True Range("D2").Select ActiveWindow.FreezePanes=True DimmynameAsString'条件不明 IfActiveSheet.Range("A2")<>""Then myname=ActiveSheet.Range("A2") EndIf Wb_new.SaveAsFilename:=Path&GroupName&"注残納期回答依頼リスト"&YMD&".xlsx",_ Password:=PSW'指定したフォルダーに保存 Wb_new.Close R_Data=R_Data+Ko LoopWhileCells(R_Data,C_Group)<>"" MsgBox"完了！" Application.ScreenUpdating=True EndSub

VBAでoutlook365が起動しません。EXCELまたは、OUTLOOK設定がおかしいのでしょうか。 メール一括作成のボタンを押しても『記載に誤りが無いことを確認しましたか？』『"送信完了しました』のメッセージは出るのですが、outlookが起動しませんし下書ホルダにも保存されません。 EXCELは他のマクロは動作しますし、Outlookはセキュリティ(トラストセンター)設定も有効です。どなたかご教示いただけますようお願いいたします。 添付でEXCEL画面の画像と下記に対象の記述を記します。 ------------------------------------------------------- Sub メール作成() Dim objOutlook As Outlook.Application Dim objMail As Outlook.MailItem Dim wsMail As Worksheet Dim filead As String Dim tenp1 As String Dim tenp2 As String 'メール立ち上げ Set objOutlook = New Outlook.Application Set wsMail = ThisWorkbook.Sheets("リスト") '添付ファイルのアドレスを変数にする filead = Worksheets("リスト").Range("B3").Value '共通添付データのアドレスを読む tenp1 = filead & "\" & Worksheets("リスト").Range("B4") tenp2 = filead & "\" & Worksheets("リスト").Range("B5") Dim kobetsumail1 As String Dim kobetsumail2 As String Dim adrs1 As String Dim asrs2 As String '変数iを設定。最初は1 Dim i As Long i = 1 '送付前の確認メッセージ Dim rc As Long rc = MsgBox("記載に誤りが無いことを確認しましたか？", vbYesNo + vbQuestion, "確認") If rc = vbNo Then MsgBox "中断しました" End End If '基準となるセルを選択 Worksheets("リスト").Select Range("B7").Select '取引先名が書かれているB列が空欄になるまで続ける Do Until ActiveCell.Offset(i, 0).Value = "" '送付チェック欄が○なら作業を続ける If ActiveCell.Offset(i, 2).Value = "○" Then Set objMail = objOutlook.CreateItem(olMailTtem) '個別メールのデータ名称を読む Dim CC12(1) As String CC12(0) = ActiveCell.Offset(i, 6).Value CC12(1) = ActiveCell.Offset(i, 8).Value 'メールを作成する With wsMail objMail.to = ActiveCell.Offset(i, 4).Value objMail.CC = Join(CC12, ";") objMail.Subject = Range("B1").Value objMail.Bodyformat = olFormatPlain objMail.body = Range("B7").Offset(i, 0) & vbCrLf & Range("E7").Offset(i, 0) & "様" & vbCrLf & vbCrLf & Range("B2").Value & vbCrLf & vbCrLf kobetsumail1 = ActiveCell.Offset(i, 9).Value asrs1 = filead & "\" & kobetsumail1 kobetsumail2 = ActiveCell.Offset(i, 10).Value asrs2 = filead & "\" & kobetsumail2 If Range("B4").Value <> "" Then objMail.Attachments.Add tenp1 End If If Range("B5").Value <> "" Then objMail.Attachments.Add tenp2 End If If ActiveCell.Offset(i, 9).Value <> "" Then objMail.Attachments.Add asrs1 End If If ActiveCell.Offset(i, 10).Value <> "" Then objMail.Attachments.Add asrs2 End If objMail.Display End With End If i = i + 1 Loop Set objOutlook = Nothing MsgBox "送信完了しました" End Sub

作成したマクロは、CSVのカンマで区切られたデーターを、 １）作成する原本をコピーしたシートに値で貼付け（手動） ２）データータブの区切り位置指定ウィザードで指定(マクロボタン作成/標準モジュール）。 ３）関数と書式設定で文字A1＝B3（VBA作成のカレンダーで月日を選択）+C3（関数で指定の文字） ※VBA作成のカレンダーは以下の井上様作成のカレンダーを設置しました。 https://www.asahi-net.or.jp/~ef2o-inue/download/sub09_020_025.html ４）A1の文字をシート名に、また同じシート名が既にある場合、シート名（数字追加）をVBAで作成。 ５）B3の月日変更に伴ってA1自動変更時、シート名も再度変更。その際、同じシート名が既にある場合、シート名（数字追加）をVBAで作成。 現在、１～３だけであればエラー無。４～５を作成しましたが、 「ActiveSheet.Name = ActiveSheet.Range("$A$1")」でエラーがでます。 まずはこのエラーの解決方法を教えてほしいです。 最終的には１でCSVからコピーして（手動）、A13をクリックしたイベント？VBAで、値で貼付けから先総て自動でできるとうれしいです。難しいでしょうか？ Excel2013　Windows10です。 Excelファイルをウェブ上に上げました。下記アドレスになります。 https://drive.google.com/file/d/1u-SPH2FdThyVPbu7_ddbKl0mts2_D4pb/view?usp=sharing sheet４とsheet５のシートモジュールは同じです。sheet6のみ違うやり方を記載しています。 どちらがよいのかわからず、途中になっています。 どうぞ宜しくお願い致します。

セルに入力された値から計算を経て配列を作成し、配列を参照して散布図を作成するマクロを作成しています。 シートが保護されていない状態でマクロが正常に動作するのを確認しましたが、シートの保護を有効にして実行すると 実行時エラー '-2147467259 (80004005)' 'ChartType' メソッドは失敗しました:'_Chart'オブジェクト というようなエラーが発生します。 ActiveSheet.Shapes.AddChart2.Select ActiveChart.ChartType = xlXYScatterLines　←ここでエラーが発生 新たに作成されたチャート自体にも保護が有効になっていることが原因かと考え ActiveSheet.Shapes.AddChart2.Select ActiveSheet.ChartObjets(1).Locked = False ActiveChart.ChartType = xlXYScatterLines としてみましたがエラーは解決しませんでした。 シートの保護を有効にしたときにのみ発生するエラー、問題点や解決方法をご存知の方がいらしたらご教示お願いします。 あるいはシートの保護機能以外にシートの編集を制限する方法があればそれでもかまいません。 完成したブックを他人が使用する際に予期せぬ動作を防ぐため、特定のセル以外の編集をロックしたい次第です。 よろしくお願いします。

お世話になっております。 どうしてもできない部分があり、質問させてください。 現在、Visual Basicからデータベースに登録できるようなツールを作っています。 StringBuilder.Appendメソッドを通して 条件に合致した社員にはデータを新しくINSERTするようなものです。 ここは問題なくできているのですが、このINSERTで追加されたすべての行をDataGridViewに表示して確認できればと試行錯誤しております。 単純にSELECT文を後に実行すれば、できるのですが、 今回のINSERTではなく、別途INSERTしたデータも抽出されてしまいます。 いま、追加したデータのみ表示ができる方法が有れば教えてください。 Visual Studio2017 Oracleデータベースを使用しています。

BVA、マクロ初心者です。 エクセルで、例えばA3に「消費税１０」という言葉が入っていたら D3にB3＊１．１、E3にC3*１．１をそれぞれ計算させたい、 という場合について質問させて下さい。 指令をD3,E3の２つに出すということです。 どんなVBAを組めばいいでしょうか。使える関数？か 何か分かりませんが教えてください。

フォルダに１ファイルだけテキストファイルＡがあり、 別のフォルダに、ファイル名のリスト(拡張子無)が付いている テキストファイルがあります。 リストは、ファイル名ごとに改行されています。 ファイルＡをリストに書かれたファイル名でテキストファイルとして コピーするには、どういうプログラムを書けばよいでしょうか。 よろしくお願いします。

A B C D E 1 2 表　　　　　　　　題 3 月 日 現金/預金 項　　　目 金　　　　額 4 7 7 普 通 預 金 仕入掛支払 5000 5 1 8 現　　金 雑費 9000 6 5 10 現　　金 旅費交通費 80000 7 2 7 普 通 預 金 仕入掛支払 5000 8 2 8 普 通 預 金 仕入掛支払 45000 9 2 10 現　　金 旅費交通費 80000 10 3 12 現　　金 現金仕入 80000 11 2 19 現　　金 旅費交通費 63000 12 4 8 普 通 預 金 仕入掛支払 45000 13 1 8 普 通 預 金 仕入掛支払 45000 ：　　：　　　　：　　　　　：　　　　　　　： ：　　：　　　　：　　　　　：　　　　　　　： 　　　　Range("A1:A3").CurrentRegion.sort _ Key1:=Range("A1"), Order1:=xlAscending, _ Key2:=Range("B1"), Order2:=xlAscending, _ Orientation:=xlTopToBottom, Header:=xlGuess　 これでソートすると中途半端な並び替えになるのですがご指摘願えますか　月と日を並び替えたいのですが　

Visual Basicについて教えてください。 VBで、 Oracleデータベースと接続し、 アプリ内でテキストボックスに入力した番号のデータを持ってくるというようなものを作ったのですが、それを他の人に渡すことができません。 ビルドして、exeファイルを渡せば使えるものだと認識していたのですが、実際に自分の端末でもexeファイルから開こうとするとエラーになってしまいます(;_;) 初歩的なところを間違えているかと思いますが教えていただければ、助かります。

VBA熟練者の方々にご相談です。 以下の工程を既存のマクロに追加したいのですが、コードのご教授お願いいたします。 現状 下記のVBAで、template.docxを立ち上げ、エクセルのテキストを転記している状態です。 ーーーーーーーーーーーーーーーーーーー Sub EXCEL_WORD04() 　Dim WordApp As Object Dim WordDoc As Word.Document Dim I, lRow As Long Dim ExcelText Set WordApp = CreateObject("Word.Application") WordApp.Visible = True lRow = Cells(Rows.Count, "A").End(xlUp).Row ' Set WordDoc = WordApp.Documents.Open("H:\***\***\***\template.docx") With WordApp For I = 2 To lRow ExcelText = Cells(I, "A").Text & vbLf .Selection.TypeText ExcelText Next I End With End Sub ーーーーーーーーーーーーーーーーーーー 追加したい事。 template.docxが保存されているフォルダに、 “転記した日”_常勤役員会報告書（XX統計“転記した日の前の月”月期について）として保存できるようにしたいです。 (例)220804_常勤役員会報告書（XX統計7月期について） よろしくお願いいたします

初心者です。 ExcelのVBAで質問です。 Val(txt数値S1) Val(txt数値S2) Val(txt数値S3) Val(txt数値S4) Val(txt数値S5) Val(txt数値S6) Val(txt数値S7) Val(txt数値S8) 上記の変数に好きな数値を入力できる変数があるのですが、 これを配列として書かずに、 For i = "txt数値S"(1 To 8)のように記入するような簡潔に書く方法はありますしょうか？

【初心者です】 現在独学でExcelのVBAを学んでいるのすが、 数値を入力する箱（= a) を８個作り、その数値を自分で入力したのちに、 For文で簡潔に合計した数値を出力させたいのですが、やり方が分かりません。 Suuchiの数は８個で、それぞれに数値を入力して、出力する流れです。 下記の文までは思いついたのですが「？？？」に該当するもとのをどのように作成すれば良いのか教えていただけないでしょうか？ また、そもそもの書き方が違う場合にも指摘していただけると助かります。 Dim Suuchi(0 To 7) As Integer '数値数 Dim total As Integer '合計値 Dim i As Integer 'カウンタ数値 For i = 0 To 7 Suuchi(i) = ？？？ total = total + Suuchi(i) Next i If chkチェックボタン.Value Then MsgBox "数値の合計は「" & total & "」です", , "数値合計値" End If

EXCEL　VBAである既定の（例えば注文書シート）みたいなのがあったとして、これを注文書が増えるごとに下にその範囲のコピーを下に追加 してゆきたい。これは、書式がいろいろと決まっているのと、他の関数でその中に値を色々と埋めています。また、これと紐づくもので、注文書明細や、その他のシートがあるので、それらもそれぞれ下方向にコピーしています。 一つのシートのコピー例が、 Rows(intUpperLine & ":" & intLowerLine).Select Selection.Copy Rows((ir * (i + 1)) + 1).Select Selection.Insert Shift:=xlDown というような感じでループしている。 これらが１０件くらいならば、ちょっと待つがなんとか なるのですが、５０件とかいくと３０分以上かかります。 何か、知恵を賜りたいです。 よろしくお願いします。 尚、シートを横展開することも考えたのですが、これだと 限りなく横へスクロールするので、お客様からNGだされました。 よろしくお願いします。

visual stadio2022で、サイドバーにファイル一覧が表示されると思うのですが、たまに誤ってドラッグ&ドロップしてファイルがどこかに移動してしまいます。 ファイルをドロップ&ドラッグするのを禁止もしくは警告が出る設定はありませんか？

2500行ぐらいあるExcel データを　21行置きに10秒ぐらい閲覧するマクロを作成したのですが、5回に３回ぐらい　988行ぐらいのところで、停止してしまいます。プログラムのどこがいけないのでしょうか？ Option Explicit 'Sleepを使う Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long) Sub scroll() 　’準備のため20秒ストップを入れる ActiveSheet.Range("A1").Select Sleep 20000 　‘最初の8行目で一旦停止 ActiveWindow.SmallScroll Down:=8 Sleep 10000 　’ここからスタート Dim i As Long For i = 1 To 121 ActiveWindow.SmallScroll Down:=21 Sleep 10000 Next i End Sub

先日来、VBAマクロが突然消える症状で困惑しておりましたが、本欄に投稿することで解決しました。 その過程で、既存のExcel Bookにあるマクロの一覧を別のフォルダーに取り出し、一覧にしたいと思いました。 Web検索でその方法を見つけ、MyMacroFolderに一覧とすることが出来ました。しかし、これらは添付ファイルのようにmodule1.bas,module2.bas.....であり、どのようなマクロか分かりません。それでExcel VBAを使ってmodule1,module2,...と開きながら、sub マクロ名で記されている名前を module1 マクロ名１ module2　マクロ名2 . . のように出力したいのですが、どのように記述すればよろしいのでしょうか？

質問します。 Visual BasicからOracle データベースに登録するときに、 エラーが発生したときにメッセージを出るようにしていますが、例えば、ORA-00000のセレクト文抽出件数がない場合、ORA-00001のinsertで既に登録があるとき、など、システムを使う人がわかりやすいようにエラーメッセージそれぞれを二つだけ変えたいと思うのですが、エラーメッセージ分岐方法がわかりません。 ex.numberとかで指定できるかと思ったのですが、できなかったので方法を教えてください。 よろしくお願いします。

Excelマクロブックと同じフォルダ内にある複数のPNGファイル（画像）を、 このマクロブックのアクティブシートに一括で挿入する（場所はどこでも大丈夫です）マクロの書き方を教えて欲しいです。 質問が分かりづらかったら申し訳ありません。 どなたかご教授いただければ幸いです。

質問させてください。 Visual Basicからデータベースに接続をして、SQL文を実施できるツールを作っています。 接続はできているようなのですが、結果を画面に表示する方法がわかりません。 セレクト文結果として、デバック中にData Set ビジュアルライザー？では確認できます。 ボタンを押したらセレクト文を実行して、ラベルやDatawGridViewに表示させる方法を教えてください。 できそうなの処理をすると、DataTableの型にあっていない、などエラーがでてしまいます。

Visualbasic 2010 を利用してWindowsFormアプリケーションを開発しております。 データベースはORACLE11を利用しております。 VB側よりOracleDataAdapterを利用してDatatableにORACLEのSELECT結果を格納しています。 DataGridViewには上記のDataTableをDataSourceとして割り当てております。 このDataGridViewに並び替え機能を組み込んでおります。 ※DataViewのSortを利用して並び替えを実現しております。 この後にDataGridViewの行削除を行うと以下の例外が発生します。 一意制約(XXX.PKY_テストデータ)に反しています Oracle.DataAccess.Client.OracleException これはDataTableをSortしたためOracleDataAdapterと一致しなくなったことが原因ではないかと推測しております。 DataGridViewの並び替えを行っても正常に行削除を行いDataTableにも反映する方法が分る方がいらっしゃいましたらご教授頂けないでしょうか。 VBソース抜粋 ・データ抽出 '/ SQLをOracleで実行した結果をデータアダプタに格納 Dadp5 = New OracleDataAdapter("SELECT * from テストデータ", CONFIG.Database) Dadp5.Fill(dt_test) Me.DataGridView_TEST.DataSource = dt_test ・並び替え(降順) Dim dv = New DataView(dt_test) dv.Sort = "テストコード DESC" dt_test = dv.ToTable Me.H_DataGridView_test.DataSource = dt_test ・行削除 Dim scBuilder As New OracleCommandBuilder(Dadp5) '/ データグリッドビューの編集内容をデータベースへ反映 '/ 生成されたSQLを実行する Dadp5.Update(dt_test) ※ここで例外が発生致します。 お手数おかけ致しますが宜しくお願い致します。 以上です。