Visual Basic

お詳しい方宜しくお願い致します。 一番初めにコードを提供して頂けた方にAmazonギフトコード3,000円提供します。 急ぎでどうしてもエラーがないコードが知りたい為です。 Excelで"全体"と"分析"シート以外のシート(ここでは”A”とB”)を"全体"シートに転記したいです。(添付ファイルはAシートしか載せていません) 以下のコードをマクロで実行すると"全体"シートに集計はちゃんとされていますが、エラーが出ます。 実行時エラー'1004': 'Select' メソッドは失敗しました '_Worksheet'オブジェクト 最初のシートのcellsの行数カウントとシート選択部分が間違えているのが原因のようですが、コードが分からなくて・・・以下、VBAです。 ----------------------------------------------------------- Sub 複数シートのデータを1枚のシートにまとめる_シートオプションあり() '複数シートを１枚 '全体シートがあるか調べる Dim 貼付シート As Worksheet, あり As Boolean For Each 貼付シート In Worksheets If 貼付シート.Name = "全体" Then あり = True Exit For End If Next 貼付シート ' "全体"が存在しなければメッセージを表示して処理を終了 If あり = False Then MsgBox "貼り付けシートがありません。終了します。", vbInformation, "エラー" Exit Sub End If 'シートの内容クリア Worksheets("全体").Select Range("A1").CurrentRegion.Clear '各シートで処理をする Dim 枚数 As Long, シート As Worksheet 枚数 = 0 Dim 除外辞書 As Object, 対象辞書 As Object, 配列 As Variant Dim 除外配列 As Variant, 対象配列 As Variant, 数 As Long Set 除外辞書 = CreateObject("Scripting.Dictionary") Set 対象辞書 = CreateObject("Scripting.Dictionary") '除外配列に、除外対象を代入 配列 = Split("全体,分析", ",") 除外配列 = 配列 For 数 = 0 To UBound(除外配列) 除外辞書.Add 除外配列(数), "除外" Next 数 'シート名が除外辞書になければ、対象辞書に加える For Each シート In Worksheets If Not 除外辞書.Exists(シート.Name) Then 対象辞書.Add シート.Name, "対象" End If Next シート '対象のキーを、配列に入れる 対象配列 = 対象辞書.keys '配列に入れた対象に、順次処理をする For Each シート In Worksheets(対象配列) Call 複数シートのデータを1枚のシートにまとめる(シート, 枚数) Next End Sub Sub 複数シートのデータを1枚のシートにまとめる(シート As Worksheet, 枚数 As Long) '複数シートを１枚 Application.ScreenUpdating = False ' 画面描画を停止 Application.DisplayAlerts = False ' 警告表示を停止 Dim 右下セル As String, セル範囲 As String, 貼り付け先範囲 As Range, 貼り付け先セル As String 'シートが"全体"ではない場合、"全体"にデータを貼り付ける If シート.Name <> "全体" Then 枚数 = 枚数 + 1 'コピーする範囲を取得 シート.Select Dim 最終行 As Long '表の最終行を決定 最終行 = Cells(Rows.Count, Range("G5").Column).End(xlUp).Row セル範囲 = "A5" & ":" & Cells(最終行, Range("P5").Column).Address(False, False) If 枚数 = 1 Then シート.Range(セル範囲).Copy Worksheets("全体").Range("A1").PasteSpecial Paste:=xlPasteAll Worksheets("全体").Range("A1").PasteSpecial Paste:=xlPasteValues Else '表全体の末端を右下セルとして取得 Worksheets("全体").Select Range("A1").CurrentRegion.Select 右下セル = Cells(Selection.Row + Selection.Rows.Count - 1, Range("A1").Column).Address(False, False) 貼り付け先セル = Worksheets("全体").Range(右下セル).Offset(1, 0).Address(False, False) シート.Range(セル範囲).Offset(1, 0).Resize(Range(セル範囲).Rows.Count - 1).Copy Worksheets("全体").Range(貼り付け先セル).PasteSpecial Paste:=xlPasteAll Worksheets("全体").Range(貼り付け先セル).PasteSpecial Paste:=xlPasteValues End If End If Worksheets("全体").Activate Application.DisplayAlerts = True ' 警告表示を再開 Application.ScreenUpdating = True ' 画面描画を再開 End Sub

お詳しい方宜しくお願い致します。 Excelで"全体"シート以外のシート(ここでは”A”とB”)を"全体"シートに転記したいです。 以下のコードをマクロで実行すると"全体"シートに集計はちゃんとされていますが、エラーが出ます。 実行時エラー'1004': 'Select' メソッドは失敗しました '_Worksheet'オブジェクト デバッグをするとシート.Selectの部分が間違えていると表記されます。 どのようにコードを変えればエラーが出なくなるでしょうか？ -------------------------------------------------------------------- Sub 複数シートのデータを1枚のシートにまとめる_シートオプションあり() '複数シートを１枚 '全体シートがあるか調べる Dim 貼付シート As Worksheet, あり As Boolean For Each 貼付シート In Worksheets If 貼付シート.Name = "全体" Then あり = True Exit For End If Next 貼付シート ' "全体"が存在しなければメッセージを表示して処理を終了 If あり = False Then MsgBox "貼り付けシートがありません。終了します。", vbInformation, "エラー" Exit Sub End If 'シートの内容クリア Worksheets("全体").Select Range("A1").CurrentRegion.Clear '各シートで処理をする Dim 枚数 as Long, シート As Worksheet 枚数 = 0 Dim 除外辞書 As Object, 対象辞書 As Object, 配列 As Variant Dim 除外配列 As Variant, 対象配列 As Variant, 数 As long Set 除外辞書 = CreateObject("Scripting.Dictionary") Set 対象辞書 = CreateObject("Scripting.Dictionary") '除外配列に、除外対象を代入 配列 = Split("(全体, 分析)のシートを、除いて実行", ",") 除外配列 = 配列 For 数 = 0 To UBound(除外配列) 除外辞書.Add 除外配列( 数 ), "除外" Next 数 'シート名が除外辞書になければ、対象辞書に加える For Each シート In Worksheets If Not 除外辞書.Exists(シート.Name) Then 対象辞書.Add シート.Name, "対象" End If Next シート '対象のキーを、配列に入れる 対象配列 = 対象辞書.keys '配列に入れた対象に、順次処理をする For Each シート In Worksheets(対象配列) Call 複数シートのデータを1枚のシートにまとめる(シート,枚数) Next End Sub Sub 複数シートのデータを1枚のシートにまとめる(シート As Worksheet, 枚数 As Long) '複数シートを１枚 Application.ScreenUpdating = False ' 画面描画を停止 Application.DisplayAlerts = False ' 警告表示を停止 Dim 右下セル As String, セル範囲 As String, 貼り付け先範囲 as Range, 貼り付け先セル As String 'シートが"全体"ではない場合、"全体"にデータを貼り付ける If シート.Name <> "全体" Then 枚数 = 枚数 + 1 'コピーする範囲を取得 シート.Select Dim 最終行 As Long '表の最終行を決定 最終行 = Cells(Rows.Count, Range("G5").Column).End(xlUp).Row セル範囲 = "A5" & ":" & Cells(最終行, Range("P5").Column).Address(False, False) If 枚数 = 1 Then シート.Range(セル範囲).Copy Worksheets("全体").Range("A1").PasteSpecial Paste:=xlPasteAll Worksheets("全体").Range("A1").PasteSpecial Paste:=xlPasteValues Else '表全体の末端を右下セルとして取得 Worksheets("全体").Select Range("A1").CurrentRegion.Select 右下セル = Cells(Selection.Row + Selection.Rows.Count - 1, Range("A1").Column).Address(False, False) 貼り付け先セル = Worksheets("全体").Range(右下セル).Offset(1, 0).Address(False, False) シート.Range(セル範囲).Offset(1, 0).Resize(Range(セル範囲).Rows.Count - 1).Copy Worksheets("全体").Range(貼り付け先セル).PasteSpecial Paste:=xlPasteAll Worksheets("全体").Range(貼り付け先セル).PasteSpecial Paste:=xlPasteValues End If End If Worksheets("全体").activate Application.DisplayAlerts = true ' 警告表示を再開 Application.ScreenUpdating = True ' 画面描画を再開 End sub

エクセル・vbaに不慣れなためわかりづらかったら申し訳ありません。 コンマ区切りの数字をsplit関数で分割して指定セルに表示したいと考えており、以前質問し回答をいただいた内容でやりたいことが出来るようになりました。 ただし、若干出力場所等の変更を行いたいのですが、変更することが出来ません。 以前はA～C列にあるものをE～H列・J～M列・O～R列に表示する。 その際、A～C列にあるコンマ区切りの数字は3つのものと４つのものがあります。画像の上段部分をご確認ください。 その際のマクロは下記のとおりです。 Sub Test() Dim i As Long, j As Long, k As Long Dim tmp As Variant For i = 1 To 3 For j = 3 To 11 tmp = Split(Cells(j, i).Value, ",") For k = 0 To UBound(tmp) If k < 4 Then Cells(j, i).Offset(0, i * 4 + k).Value = tmp(k) End If Next Next Next End Sub 変更したいのは、AC８～AE16にコンマ区切りの数字があります。 AC列にある数字はAI8～AL16にAD列にある数字はAS8～AV16に AE列にある数字はBC8～BF16に表示したいと考えています。 コンマ区切りの数字は3つのものと４つのものがあります。 （画像の下段部分をご確認ください。） 上記のマクロでは下記の部分を変更する必要なのかと考えていますが、変更方法がわかりません。 お分かりの方教えていただけたら幸いです。 どうぞよろしくお願いいたします。 For k = 0 To UBound(tmp) If k < 4 Then Cells(j, i).Offset(0, i * 4 + k).Value = tmp(k)

エクセルに不慣れなため教えていただけたら幸いです。 A３～A11・B3～B11・C3～C11列にコンマ区切りの数字があります。 列によってはコンマで区切られた数字が3つのものと4つのものが混在しています。 split関数でコンマ区切りの数字を分割してE～Ｈ列・J～M列・O～R列に表示したいと考えています。 先ほど別の質問で下記のマクロを教えていただいたのですが、 その際は、A１～A9にあるものをD～G列に表示するというものでした。 よくよく考えると、A列のみではなく、B・C列と複数の列を コンマ区切りしたいと考えています。 このような場合は、どうしたらよいでしょうか。 vba不慣れなためわかりづらかったら申し訳ありません。 お分かりになられるかたがいらっしゃいましたら教えていただけますでしょうか。 よろしくお願いいたします。 Option Explicit ' Sub Macro1() 　　Dim Rout As Long 　　Dim Colu As Integer 　　Dim Expression As Variant ' 　　For Rout = 1 To Cells(Rows.Count, "A").End(xlUp).Row 　　　　Expression = Cells(Rout, "A") 　　　　Expression = Split(Expression, ",") ' 　　　　For Colu = 0 To UBound(Expression) 　　　　　　Cells(Rout, Colu + 4) = Expression(Colu) 　　Next Colu, Rout End Sub

エクセルに不慣れなため教えていただけたら幸いです。 A列にコンマ区切りの数字があります。 列によってはコンマで区切られた数字が3つのものと4つのものが混在しています。 split関数でコンマ区切りの数字を分割してD～G列に表示したいと考えています。 3つのものだけだとvbaを作成できたのですが、4つ目があるときというプログラムが不明です。 現在作成済みのマクロは下記のとおりです。 Sub test() Dim SH As Worksheet Dim i As Long Set SH = Worksheets("sheet1") For i = 1 To 9 SH.Cells(i, 4).Value = Split(SH.Cells(i, 1).Value, ",")(0) SH.Cells(i, 5).Value = Split(SH.Cells(i, 1).Value, ",")(1) SH.Cells(i, 6).Value = Split(SH.Cells(i, 1).Value, ",")(2) Next i End Sub お手数ですがお分かりになられるかたがいらっしゃいましたら回答いただけたら助かりますのでよろしくお願いいたします。

エクセルにおいて 社員名簿があり ID　氏名で一覧のリストがあります またグーグルドライブ https://drive.google.com/drive/my-drive のフォルダ名称＝社員 https://drive.google.com/drive/folders/13dENSrV_XLIBb1nZ5eDhOHQR81fqtCdl において そのサブフォルダとして フォルダ名称＝1 https://drive.google.com/drive/folders/1Nijm_Nvs43szpdRv-lIUSBwUTfmxmieW 　フォルダ名称＝2　・・・ ID＝1　氏名＝山田　の場合 エクセルシートに　フォルダ1のリンク先を 上記のように ひとりずつクリックして https://drive.google.com/drive/folders/1Nijm_Nvs43szpdRv-lIUSBwUTfmxmie https://drive.google.com/drive/folders/*********** のように しらみつぶしに コピペして エクセルの社員名簿に 貼り付けて行けば 可能ではあるのですが 数万単位ありまして なにか そういう作業をするプログラムを 探しています これはVBAではなくて 他のプログラム言語が必要でしょうか 要は　まとめますと 自分のグーグルドライブにおいて そのなかの　例えば社員フォルダ を開き 各社員のフォルダを開く URLを、もとのエクセルの社員リスト 例えばA1がID A2が氏名 A3が　上記にあるその個人フォルダのURL このURLのコピペを自動化する プログラムを希望するのですが、 御教示くださいませ win10 office365

エクセルにおいて 社員名簿があり ID　氏名で一覧のリストがあります またグーグルドライブ https://drive.google.com/drive/my-drive のフォルダ名称＝社員 https://drive.google.com/drive/folders/13dENSrV_XLIBb1nZ5eDhOHQR81fqtCdl において そのサブフォルダとして フォルダ名称＝1 https://drive.google.com/drive/folders/1Nijm_Nvs43szpdRv-lIUSBwUTfmxmieW 　フォルダ名称＝2　・・・ たとえば1フォルダには　その社員の個人業績の記載されたpdfファイルの 1.pdfがあるとします VBAにより、たとえば ID＝1　氏名＝山田　の場合 エクセルシートに　コマンドボタンを作り コマンドボタンをクリックするとIDを尋ねられるダイアログが 出て来て、そこにIDを入力し、 そこから 上記フォルダを開くVBAを欲しいのですが たとえばID＝1とした場合 グーグルドライブの社員フォルダのなかの1フォルダに ダイレクトに到達させるのは 上記のようなURLを眺めたところ法則性も検討がつかず 無理でしょうか 宜しく御教示お願い致します win10 office365

マクロ中で、VLOOKUPを使用して、下記②のExcelファイルの職員番号と、下記①の職員番号が一致していて、①のD列にメールアドレスが入ってない場合のみ、②のファイルのメールアドレスを、①のD列へ挿入したいのですが、マクロの書き方がわかりません、何方かご教示頂けましたら、大変助かります。 ①ファイル名＝F:\11_データ\課題参画者リストまとめ\2024参画者リストまとめ_20240311.xlsx 　シート名＝参画者リスト 　職員番号＝B列2行目以降 　メールアドレス＝D列の2行目以降 　シートのA列～H列に値が入っていますが、メールアドレスのセルは、記載無し、記載有りのセルがあります。 　 ②ファイル名＝F:\12_データ\課題参画者リストまとめ\職員マスタ.xlsx 　シート名＝職員マスタ420227 　職員番号＝A列2行目以降 　メールアドレス＝C列2行目以降 　シートのA列～C列は値が入っています。 　 ※①のファイルは、データ連結マクロで複数のファイルを纏めたExcelファイルになります。 　タイムスケジューラで自動で起動させる為、vbsファイル中に、マクロファイルを設定させて、 　バッチファイルでこのvbsファイルを起動して作成しております。 　 2024年度-参画者リスト作成.vbsの中身は以下の通りで、このファイルをバッチファイルに設定して使っております。 Dim WB_PATH Const PROC_NAME = "参画者リストおまとめ" Dim excelApp Set excelApp = CreateObject("Excel.Application") WB_PATH = "C:\Users\watan\Documents\27_EXCEL教習\TEST\11_2024-課題参画者リスト\スクリプト\【自動起動】課題参画者リストまとめシートv4.xlsm" With excelApp .Visible = False Dim wb Set wb = .Workbooks.Open(WB_PATH) .Run "'" & wb.Name & "'!" & PROC_NAME .DisplayAlerts = False wb.Save wb.Close End With excelApp.Quit Set excelApp= Nothing

エクセルでプリンターを選択して印刷するマクロを下記で行っているのですが、プリンター選択ダイアログボックスでプリント中止のキャンセルボタンをクリックしてもキャンセルが有効とならず印刷されてしまいます。マクロ初心者で、どうしたらいいのか困っています。ご教授宜しくお願い致します。 Sub ネットカード印刷() 　 Sheets("ネット入力").Select Application.Dialogs(xlDialogPrinterSetup).Show ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False Sheets("ネット入力").Select End Sub

ExcelVBAの初歩的な質問です。 【質問内容】 [CheckAcolumnBrank]と[CheckBcolumnBrank]の処理を行った際に、[CheckBcolumnBrank]の結果が[CheckAcolumnBrank]の結果と行数が異なるため（5行ほど多く処理されてしまいます）、[CheckAcolumnBrank]の行数に合わせるコードを知りたいです。 ご見識のある方からの、お知恵の拝借をいただきたく、よろしくお願い申し上げます。 【前提条件】 1.シート1のA5からJ500までの範囲のセルに値が入力されています（空欄セルが不規則にあります）。 2.レコード数は10行程度から450行程度です。 3.A列のセルに値が入っていない場合は、1つ上のセルの値をコピーする挙動です。 4.B列についても、A列と同じ挙動をさせたいです。 5.最終行を求める処理は「GetLastRow」にて行います。 -------------------------------------------- Function GetLastRow() As Long ' 最終行を求める処理 Dim i As Long Dim MaxValue As Long For i = 5 To 500 If Cells(i, "A").Value <> "" Then ' A列からJ列に入力されている値の最大値を求める MaxValue = Application.WorksheetFunction.Max(Range("A" & i & ":J" & i)) If MaxValue > GetLastRow Then GetLastRow = i End If End If Next End Function -------------------------------------------- Private Sub CheckAcolumnBrank() ' A列がブランクの場合、1つ上の値をコピペする処理 Dim currentRow As Long Dim emptyColumns As Boolean Dim Lcont As Long Lcont = GetLastRow Dim ws As Worksheet Set ws = Sheets("シート1") emptyColumns = False ' A列を埋めるループ処理開始 currentRow = 6 Do While currentRow <= Lcont If IsEmpty(ws.Cells(currentRow, 1).Value) Then ws.Cells(currentRow, 1).Value = ws.Cells(currentRow - 1, 1).Value End If ' 終了条件のチェック（E列からJ列がすべて空白、かつA列の1つ上の値が異なる場合に終了） If ws.Cells(currentRow, 5).Value = "" _ And ws.Cells(currentRow, 6).Value = "" _ And ws.Cells(currentRow, 7).Value = "" _ And ws.Cells(currentRow, 8).Value = "" _ And ws.Cells(currentRow, 9).Value = "" _ And ws.Cells(currentRow, 10).Value = "" _ And (ws.Cells(currentRow, 1).Value <> ws.Cells(currentRow - 1, 1).Value) Then Exit Do End If currentRow = currentRow + 1 Loop End Sub -------------------------------------------- Private Sub CheckBcolumnBrank() ' B列がブランクの場合、1つ上の値をコピペする処理 Dim currentRow As Long Dim emptyColumns As Boolean Dim Lcont As Long Lcont = GetLastRow Dim ws As Worksheet Set ws = Sheets("シート1") emptyColumns = False ' ループ開始 currentRow = 6 Do While currentRow <= Lcont If ws.Cells(currentRow, 2).Value = "" Then ws.Cells(currentRow, 2).Value = ws.Cells(currentRow - 1, 2).Value End If ' 終了条件のチェック（E列からJ列がすべて空白、かつB列の1つ上の値が異なる場合に終了） If ws.Cells(currentRow, 5).Value = "" _ And ws.Cells(currentRow, 6).Value = "" _ And ws.Cells(currentRow, 7).Value = "" _ And ws.Cells(currentRow, 8).Value = "" _ And ws.Cells(currentRow, 9).Value = "" _ And ws.Cells(currentRow, 10).Value = "" _ And (ws.Cells(currentRow, 2).Value <> ws.Cells(currentRow - 1, 2).Value) Then Exit Do End If currentRow = currentRow + 1 Loop Set ws = Nothing End Sub --------------------------------------------

大変お世話になっております。 1）Sheet1の2行目から最終行までを取得・コピーをし、同名のシート(Sheet1)の最終行へ追加したいです。 2）BOOK1のSheet1で作業をしており、BOOK2のSheet1へ貼り付けを行います。 3）BOOK1・BOOK2 共に、最終行の判定はC列に文字が入っているものとします。 以下ですと、列が限定されてしまうため、どのようなコードを作成すればよいのか教えていただけると有難い限りです…。 ※将来的には、BOOK1の名前が異なる13シート分をBOOK2（BOOK1と同じ名前のシートが13シートあります）へ同様の作業を行いたいです…。 Sub タイトル行を除き別ファイルに追加() ' Sheets("Sheet1").Activate Rows("2:7").Select Selection.Copy Windows("BOOK2.xlsm").Activate Rows("25:25").Select Selection.Insert Shift:=xlDown Windows("BOOK1.xlsm").Activate Sheets("Sheet1").Activate Application.CutCopyMode = False End Sub ご回答を心よりお待ちしております…。 お手数ですが、どうぞ宜しくお願い申し上げます。

テキストファイル.txtにおける数値 たとえば01234567の８桁を エクセルファイルの（A,1）セルに移動すると 1234567と表示されてしまいます あるコードがあるとしまして 途中省略しますが ・・・・・ .Cells(A, 1).Value = Str(Mid(buf, Pos9 + Len9, Pos10 - (Pos9 + Len9))) これは　あるプログラムの流れということですが これで 1234567　となってしまうので このコードのあとに Range (Cells(A, 1)) .NumberFormatLocal = "@" .Value = Format(.Value, "00000000") （この場合は　８桁とすでにわかっている場合ですが もし先頭に0がいくつ付くかわからない場合のケースも 教えていただけますか） とつけましたが エラーとなります 御教示くださいませ win10 office356

Excelファイルデータの差分比較とそのセル塗りつぶしのマクロを作成したいのですが、今の自分には、下記のマクロでとどまっており、 マクロを実行するファイル内シートにデータをコピーしたり、 マクロ内でその都度、シート名の記載の変更、差分比較データ範囲の変更が必要になり、大変不便で困っております。 やりたい事は、マクロでユーザがExcelのファイルを選択出来て、 そのファイルの中の全シートのデータについて、差分比較とそのそのセルの塗りつぶしをして、塗りつぶしをファイルへ反映させて保存させることです。 どうか、お分かりの方がいらっしゃいましたら、ご教示をお願い出来ますと大変助かります。 各シート内のデータは、列、行共にほぼ同じフォーマットで値が入っています。 それらのシート内のデータで修正した箇所を見つける為、差分比較がしたいです。 例えば、シートが3つの場合は、 1つ目のシートは修正前のデータ、 2つ目のシート内は1つ目のシートの値を部分的に修正したものです。 3つ目のシート内のデータも、1つ目のデータの値を更に再修正したものです。 この3つのシート内のデータを差分比較したいです。 シートの数は、選択したファイルによって異なります。 Sub TEST1() Dim s1, s2 As Worksheet 'Worksheetsオブジェクト用 Set s1 = Worksheets("修正前S装置検索システム") '比較元シート名 Set s2 = Worksheets("修正後装置検索システム") '比較先シート名 Dim arr1 As Variant, arr2 As Variant arr1 = s1.Range("$A$2:$W$548").Value arr2 = s2.Range("$A$2:$W$548").Value For i = 1 To UBound(arr1, 1) For j = 1 To UBound(arr1, 2) If arr1(i, j) <> arr2(i, j) Then '塗りつぶし処理 s1.Cells(i + 1, j).Interior.Color = RGB(255, 0, 0) s2.Cells(i + 1, j).Interior.Color = RGB(102, 255, 51) End If Next Next End Sub

Excelシート上に設置したユーザフォームを開くボタンを実行するとフォームが開かずに新規のExcelシートが開いてしまいます。 以前までは正常に作動していたんですが••• ちなみにボタンの実行前に vbaの編集画面を一度でも開いた後はボタンを押したら正常にフォームが開くんです。 フォームを開くコード sub 起動() UserForm1.Show End Sub フォームのInitializeはコンボボックスのみです。 原因がわかりましでしょうか？

フォルダC:\Users\USER\Desktop\あいう において このダイアログを開いて そのなかのファイル（A.xml）を txtファイルとして開いて その名前を テキスト.txt として 同名で保存したいのですが Dim FileName As Variant Dim NewFile As TextFile FileName = Application.GetOpenFilename() Set NewFile = TextFile.Open(FileName) NewFile.SaveAs "テキスト.txt" Activetxtfile.SaveAs FileName:="C:\Users\PC\Desktop\あいう\テキスト.txt", FileFormat:=TextFile どうも違うようです 御教示ください

エクセルブックが開けなくなった。 添付のようなメッセージが出た後、立ち上がったと思ったら消えてしまいます。 シートは１０枚位ありコマンドボタンでマクロを起動させています。 昨日まで何の異常もなく動いていましたが、今朝からおかしくなってしまいました。どうすれば回復するかのご教示を頂ければ有難いです。

シートイベントについて教えて下さい。 A3〜A100まで計算式が入っています。 そのため、A3〜A100のセルにカーソルが動いた時に注意メッセージを表示しています。シートイベントで設定しています。 ファイル保存時、入力漏れチェックのプログラムも入れています。 入力漏れチェック実行時、自動的にA列に設定したシートイベントも実行され、メッセージボックスが表示されてしまいます。 入力漏れチェック時は、A列のシートイベントを実行不可にしたいです。 良い方法はありませんでしょうか。

今学校で4次方程式の解を求めるマクロを作っています。 2次方程式までは作りました。なんかプログラムが書かれた紙をもらって打ち込んだらできました。そのあと4次方程式（ax^4+bx^2+c=0)を作る方法を考えてどんなふうに2次方程式のプログラムを変えたらいいか考えたんですけど、その考え方が合ってるかと、プログラムを変えたところがあってるかをみてほしいです。 まずx^2をmと置いて、am^2+bm+c=0にすると、m=-b±√b^2-4ac / 2a になってここからxを求めると、x＝±√ -b±√b^2-4ac / √2a となると思います。そしたら解が4つ最大で出ると思うので、下の画像のようにプログラムを書き換えました。 家にはパソコンがなくて、学校でやろうと思うので、お返事は遅くなってしまうかもしれません。よろしくお願いします。

エクセルマクロのコードにおきまして 「フォルダの選択」ダイアログから エクセルファイル 123.xlsxを例えば　開くときに それをa.xlsxという名前に変えて 以下のそれに続くVBAコードにおいて a.xlsxを操作したいのですが、 a = Application.GetOpenFilename() Workbooks.Open a これを実行すると求めるダイアログが表示されて 使いたい123.xlsxを開くをクリックしますが これでは123.xlsxがa.xlsxにはなりません このa.xlsxのファイル名で別途ファイル作成する方法を 御教示いただけると助かります よろしくお願いします win10 office365 コードは以下　部分ですが こういう流れで作成したい所存です Sub あいう() a = Application.GetOpenFilename() Workbooks.Open a 'b.xlsxファイルを新規作成 Workbooks.Add ActiveWorkbook.SaveAs Filename:="C:\Users\USER\Desktop\あいう\b.xlsx", FileFormat:=xlXMLSpreadsheet 'a.xlsxファイルの1行目のA1～AG1のセルの値をコピー Workbooks("a.xlsx").Worksheets("Sheet1").Range("A1:AG1").Copy 'b.xlsxファイルのA3～AG3のセルに貼り付け Workbooks("b.xlsx").Worksheets("Sheet1").Range("A3:AG3").PasteSpecial xlPasteValues 以下省略 よろしくお願いします

Ｅｘｃｅｌのコンボボックスの表記と同じ表記のものをゆっくりムービーメーカーという別アプリの指定したコンボボックスから選ぶVBAマクロを開発したいです。カスタムと書かれたコンボボックスを動かしたいです。ですが、他にもclassnameやAoutmationIDが同じコンボボックスがあります。その中で自分の指定したコンボボックスを動かす方法も教えて頂きたいです。エクセルの「セリフ」sheetのE列にコンボボックスがあり、コンボボックスの中身は「表情」sheetのA列の表記（例魔理沙笑う） Ｅｘｃｅｌのコンボボックスの表記と同じ表記のものをゆっくりムービーメーカーという別アプリの指定したコンボボックスから選択するVBAマクロを開発したいです。見づらいですが画像の右端の真ん中くらいにあるカスタムと書かれたコンボボックスを動かしたいです。ですが、他にもclassnameやAoutmationIDが同じコンボボックスがあります。その中で自分の指定したコンボボックスを動かす方法も教えて頂きたいです。エクセルの「セリフ」sheetのE列にコンボボックスがあり、コンボボックスの中身は「表情」sheetのA列の表記（例:魔理沙笑う）です。ゆっくりムービーメーカーのコンボボックスにも「表情」sheetのA列の表記（例:魔理沙笑う）と同じものが複数存在します。私はゆっくりムービーメーカーのコンボボックスの中からＥｘｃｅｌのコンボボックスの表記と同じ表記のものを選択するVBAマクロを開発したいです。ご指導よろしくお願いします。下のマクロを改良したいですが、あくまで前のバージョンかつ私が作りたいマクロと似ていますが違うものなので参考程度にお願いします。 これと全く違うスクリプトでも構いません。よろしくお願いいたします。 Private Sub zputTachieParam(Param() As Variant) Dim i, j, k, row_blank, f_hetitem As Integer Dim x_char As String Dim tmp, x_last_item As Variant Dim elmYukkuri_tachie As IUIAutomationElement 'RegExpオブジェクトの作成 Dim reg As Object Set reg = CreateObject("VBScript.RegExp") '正規表現の指定 With reg .Pattern = "[^0-9]" 'パターンを指定 .IgnoreCase = False '大文字と小文字を区別するか(False)、しないか(True) .Global = True '文字列全体を検索するか(True)、しないか(False) End With hWnd = FindWindowA(vbNullString, C_アプリ名) Set uiAuto = New CUIAutomation Set elmYukkuri = uiAuto.ElementFromHandle(ByVal hWnd) Set iCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "ItemEditorView") Set elmYukkuri = elmYukkuri.FindFirst(TreeScope_Subtree, iCnd) Set iCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "ScrollViewer") Set elmYukkuri = elmYukkuri.FindFirst(TreeScope_Subtree, iCnd) Set iCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "Editor") Set elmYukkuri = elmYukkuri.FindFirst(TreeScope_Subtree, iCnd) Set iCnd = uiAuto.CreatePropertyCondition(UIA_NamePropertyId, "立ち絵") Set elmYukkuri = elmYukkuri.FindFirst(TreeScope_Subtree, iCnd) Dim elms_ComboBox As IUIAutomationElementArray Set iCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "ComboBox") Set elms_ComboBox = elmYukkuri.FindAll(TreeScope_Children, iCnd) Dim ptnVal As IUIAutomationSelectionItemPattern f_hetitem = 0 x_last_item = "" For j = 0 To elms_ComboBox.Length - 1 tmp = Split(elms_ComboBox.GetElement(j).CurrentHelpText, "\") If UBound(tmp) > 0 Then '選択されてるコンボボックス '現状の設定とパラメータ値を比較 If Param(j) <> Int(Replace(tmp(UBound(tmp)), ".png", "")) Then elms_ComboBox.GetElement(j).SetFocus 'ENDキーで最後の選択肢に持っていく wshSendKeys "{END}", True f_hetitem = 0 For k = 0 To 200 elms_ComboBox.GetElement(j).SetFocus 'Debug.Print "1> " & elms_ComboBox.GetElement(j).CurrentHelpText tmp = Split(elms_ComboBox.GetElement(j).CurrentHelpText, "\") If UBound(tmp) > 0 Then 'Debug.Print "2> " & reg.Replace(tmp(UBound(tmp)), "") If Param(j) = Int("0" & reg.Replace(tmp(UBound(tmp)), "")) Then f_hetitem = 1 Exit For End If wshSendKeys "{UP}", True Else 'Debug.Print "nohit!" wshSendKeys "{DOWN}", True Exit For End If Next End If End If Next Sleep 100 End Sub