Visual Basic

全22434件中1~20件表示
  • VBA ブックを閉じる操作をすると勝手に開く

    おはようございます。 VBAにて指定したエクセルファイル (ファイル名 Aとさせてください)を1分後に閉じるコードを 記載し、自動的に1分後に閉じるようにしているのですが 問題点が有ります。 実際に、1分経過すると指定したファイルは閉じるので 処理上は問題ないのですが 1分経過する前に自分で勝手に閉じた場合には ファイルを閉じてから1分後くらいに 勝手にAのファイルが開かれてしまいます。 勝手にAのファイルを開かれないようにしたいのですが どうすればよろしいでしょうか? コードを記載しますのでご指摘お願いいたします。 標準モジュールに記載 Sub 終了() Unload UserForm1’開いているユーザーフォームを閉じます。 Workbooks("A.xlsx").Close SaveChanges:=True’Aのファイルを上書き保存してから閉じます。 End Sub ThisWorkbookに記載 Private Sub Workbook_Open() UserForm1.Show 'ユーザーフォームを開く Application.OnTime Now + TimeValue("00:01:00"), "終了" ’1分後に指定したファイルを閉じます。 End Sub すいませんが回答よろしくお願い致します。

  • outlook vba 文中の文字列取得

    outlook vba 文中の文字列取得 本文中に、 日付:9/10 名前:田中 住所:東京 とあるとき、田中 を取得したいのですが、 名前: から改行までの文字列について、 Mid(objItem.Body, InStr(objItem.Body, "名前:") + 4, (InStr(InStr(objItem.Body, "名前:"), objItem.Body, vbCrLf))) で取得しようとしましたがうまくいきません。 田中からあとすべてが取得されてしまいます。 何か間違っていますでしょうか?

  • チェックボックスに関して(vba)

    VBA初心者のためコードを教えてくれますと助かります。 シート1にリストが記載されています。 チェックボックスで選択されている値を取得して(シート1のA列の商品名から)、チェックされている値のデータを転記するようなコードを作成したいと思っております。(別途シート追加する) 知識不足でうまく動きません。よろしくお願いします。

  • VBAに関して質問です

    VBA初心者のため教えてくれますと助かります。 シート1にリストが記載されています。 チェックボックスで選択されている値を取得して(シート1のA列の商品名から)、チェックされている値のデータを転記するようなコードを作成したいと思っております。(別途シート追加する) 知識不足でうまく動きません。よろしくお願いします。

  • Excelのworkbookの各sheetを分割

    Excelのworkbookの各sheetをそれぞれ単独のworkbookにばらかすVBAを教えて下さい。

  • vbaでifの使い方について

    if textbox1=1 then textbox 2 >=30 要するtextbox1に数字の1を入れるとtextbox2には30以下の数字しか入れられないことを表したいのですが >=の表記はできないのですかね  何かあればご教授ください

  • excel VBA 散布図 Xの値を表示させる

    タイトルの通り excelの散布図においてデータラベルを表示した際にXの値も表示させたいと考えております。 .ChartObjects(1).Chart.SeriesCollection(1).HasDataLabels = True とするとデフォルトではYの値のみ表示されています。 Excel上でデータラベルの書式設定→ラベルオプション→Xの値(X)から表示させることは出来るのですが、これをVBAで指示したいと考えております。 自信が調べた限りではヒントとなるような情報が見当たらなかったため、ご存知の方がいらっしゃいましたらご回答をお願い致します。

  • VBA オートフィルの操作方法

    VBAで使用するオートフィルの指定方法がわかりませんでしたので 質問いたします。 やりたいこと セルがAとBセルが一番下まで結合されている状態 (A1とB1セル結合・A2とB2セル結合・・・) にて、セル(A5とB5が結合されたセル)を選択し 何も数字が無ければ、数字があるセルまで選択する (この場合End(xlUp)にて数字がある一番上のセルを選択する) そのあと、セル(A5とB5が結合されたセルの一つ上)まで オートフィルをしたいのですが 下記のコードだと実現できませんでした。 おそらくrange指定がキチンとできていないのと セルが結合されているのも要因の様な気がします・・・ すいませんが実現できるコード記載お願いできますでしょうか。 回答宜しくお願い致します。 Cells(5, 1).End(xlUp).Select Selection.AutoFill Destination:=Range(Cells(5, 1).End(xlUp), Cells(5, 1).Offset(-1, 0)), Type:=xlFillCopy

  • VBAがとまります。

    フォルダ内の全てのエクセルデータを一つにまとめたいのですが、 下記を実行すると、『実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーです。』のメッセージが出て先に進みません。対象のデータを開いて実行しても同様でした。 調べましたがよくわかりませんので、ご教示いただけませんでしょうか。 基本的なところかもしれませんが、よくわかりません。 どうぞよろしくお願いいたします。 ------------------------------------------------------- 'プログラム1|プログラム開始 Sub GetExcelDataInFolder() 'プログラム2|シート設定 Dim ws1 As Worksheet Set ws1 = ThisWorkbook.Worksheets("Sheet1") 'プログラム3|FileSystemObjectの設定 Dim fs As FileSystemObject Set fs = New FileSystemObject 'プログラム4|対象フォルダを取得 Dim myfolder As Folder Set myfolder = fs.GetFolder(ThisWorkbook.Path) 'プログラム5|対象フォルダ内の全ファイルを処理 Dim myfile As File For Each myfile In myfolder.Files 'プログラム6|拡張子が「xlsx」のファイルのみを処理 If fs.GetExtensionName(myfile) = "xlsx" Then 'プログラム7|フォルダ内のエクセルを開いてシートを設定 Dim wb As Workbook Set wb = Workbooks.Open(Filename:=myfile) Dim ws2 As Worksheet Set ws2 = wb.Worksheets(1) 'プログラム8|開いたエクセルの最終行を取得 Dim cmax As Long cmax = ws2.Range("A65536").End(xlUp).Row Debug.Print myfile.Name & "のcmax=" & cmax 'プログラム9|開いたエクセルのデータを転記 Dim i As Long For i = 2 To cmax Dim cmax1 As Long cmax1 = ws1.Range("A65536").End(xlUp).Row ws1.Range("A" & cmax1 + 1 & ":E" & cmax1 + 1).Value = ws2.Range("A" & i & ":E" & i).Value Next 'プログラム10|エクセルを閉じる wb.Close 'プログラム11|オブジェクト解放 Set ws2 = Nothing Set wb = Nothing End If Next 'プログラム12|エクセルを保存 ThisWorkbook.Save 'プログラム13|オブジェクト解放 Set myfolder = Nothing Set fs = Nothing 'プログラム14|プログラム終了

  • VBAが止まります。

    フォルダ内の全てのエクセルデータを一つにまとめたいのですが、 下記を実行すると、添付ファイルのメッセージが出て先に進みません。 調べましたがよくわかりませんので、ご教示いただけませんでしょうか。 画像の最上部の『'プログラム0|変数設定の指定Option Explicit』が欄外に はみだしていて直せません、こちらが原因でしょうか。 ------------------------------------------------------- 'プログラム1|プログラム開始 Sub GetExcelDataInFolder() 'プログラム2|シート設定 Dim ws1 As Worksheet Set ws1 = ThisWorkbook.Worksheets("Sheet1") 'プログラム3|FileSystemObjectの設定 Dim fs As FileSystemObject Set fs = New FileSystemObject 'プログラム4|対象フォルダを取得 Dim myfolder As Folder Set myfolder = fs.GetFolder(ThisWorkbook.Path) 'プログラム5|対象フォルダ内の全ファイルを処理 Dim myfile As File For Each myfile In myfolder.Files 'プログラム6|拡張子が「xlsx」のファイルのみを処理 If fs.GetExtensionName(myfile) = "xlsx" Then 'プログラム7|フォルダ内のエクセルを開いてシートを設定 Dim wb As Workbook Set wb = Workbooks.Open(Filename:=myfile) Dim ws2 As Worksheet Set ws2 = wb.Worksheets(1) 'プログラム8|開いたエクセルの最終行を取得 Dim cmax As Long cmax = ws2.Range("A65536").End(xlUp).Row Debug.Print myfile.Name & "のcmax=" & cmax 'プログラム9|開いたエクセルのデータを転記 Dim i As Long For i = 2 To cmax Dim cmax1 As Long cmax1 = ws1.Range("A65536").End(xlUp).Row ws1.Range("A" & cmax1 + 1 & ":E" & cmax1 + 1).Value = ws2.Range("A" & i & ":E" & i).Value Next 'プログラム10|エクセルを閉じる wb.Close 'プログラム11|オブジェクト解放 Set ws2 = Nothing Set wb = Nothing End If Next 'プログラム12|エクセルを保存 ThisWorkbook.Save 'プログラム13|オブジェクト解放 Set myfolder = Nothing Set fs = Nothing 'プログラム14|プログラム終了

  • VBAが止まります。

    皆さん、いつもありがとうございます。 下から14行目の『 objMail.Attachments.Add asrs1』で止まってしまします。 下から14行目の『 objMail.Attachments.Add asrs1』で止まってしまします。 asrs1をadrs1へ修正したりしましたが、改善されません。 昨日まで動いたいたのですが。 皆様、修正方法を教えていただけますでしdょうか。 ------------------------------------------------------- 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 objMail.Save End With End If i = i + 1 Loop Set objOutlook = Nothing MsgBox "下書きに保管しました" End Sub

  • VBA チャートグラフの凡例 表示非表示

    タイトルの通り、凡例の表示非表示を設定したいと考えています。 HasLegendプロパティで凡例のオンオフを切り替えられる事までは理解したのですが 例えばグラフに要素が10個あると凡例も10個表示されると思います。 しかし今回は10このあるうちの指定した3つのみの凡例を表示するというようなことをしたいのです。 オブジェクトウィンドウを確認してみましたがそれらしいプロパティは見当たらず... なにか方法があればご教授願います。 よろしくお願いします

  • 【困っています】VBA 追加処理の記述を教えてくだ

    VBA 追加処理の記述を教えてください。 お世話になります。マクロの初心者です、稚拙な部分はご容赦ください。 下記マクロを実行すると、元データが複数のファイルに分割されます。 追加作業としては、①シートの保護 出来上がった全ファイルのシートは1つ(シート名:『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が起動しません。

    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

  • 1004 別の名前を入力して下さい。VBAエラー

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

  • VBA ChartTypeメソッドに関するエラー

    セルに入力された値から計算を経て配列を作成し、配列を参照して散布図を作成するマクロを作成しています。 シートが保護されていない状態でマクロが正常に動作するのを確認しましたが、シートの保護を有効にして実行すると 実行時エラー '-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 データベースに登録

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

  • 指令が2つ BVA

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

  • フォルダにあるファイルをリスト中ファイル名でコピー

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

  • エクセル

    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  これでソートすると中途半端な並び替えになるのですがご指摘願えますか 月と日を並び替えたいのですが