Visual Basic

Visualbasic2013でFormアプリケーションを開発しております。 Form上にElementhostを配置しWPFの表示も行っております。 OSがWindows11(23H2)の場合にInitializecomponentで異常終了する事象が 発生する事が分かりました。23H2が適用されていない場合は異常終了は 発生しません。 異常終了発生時のイベントログには以下が出力されています。 障害が発生しているモジュール名: ucrtbase.dll、バージョン: 10.0.22621.3374、タイム スタンプ: 0xac92626e 例外コード: 0xc0000409 障害オフセット: 0x0009e34b 障害が発生しているプロセス ID: 0x0x2378 障害が発生しているアプリケーションの開始時刻: 0x0x1DA8963F1A2F9E9 上記の異常終了を改善する方法が分かる方がいらっしゃいましたらご教授頂けないでしょうか。

windows11でvisualbasic2013でFormアプリケーションを開発しており ElementHostを利用してWPFを利用しております。 全ての端末ではないのですがシステムを起動した際に「Controls.Add(Me.ElementHost2)」 で異常終了する端末が存在します。 異常終了する端末のOSはWindows11です。 同じOSであっても異常終了しない端末も存在します。 異常終了する端末はtry/chachで例外も補足されません。 異常終了が発生しないように改善したいのですが、例外も補足できず どのように対応すればよいのか分からない状況です。 分かる方がいらっしゃればご教授頂けないでしょうか。

Excel請求書から出力したPDFファイルをメールソフトのThunderbirdでメールに添付して送信したいのですが、 添付ファイルのパスが間違っているのか「＊＊＊.pdfファイルが存在しないためメッセージに添付できませんでした。」とエラーになってしまいます。 PDFファイル出力は問題無く出来ており、メール自体は作成できるところまでは出来ているのですが、肝心のファイル添付が出来なくて困っております、どなたかお助け願えませんでしょうか。 ※PDFファイルの保存場所は任意に選択⇒ファイル名は顧客名で都度出力される形になってます。 Sub PDF出力メール送信テスト用() Dim fname As String Dim pdfname1 As String Dim pdfname2 As String Dim rtn As Long Dim wsh As Object If MsgBox("PDFをメール送信する場合はＯＫ、送信しない、または間違ってこのボタンをクリックした場合はキャンセルをクリックしてください。", vbOKCancel) = vbCancel Then End End If 'pdfname1は会社名、pdfname2は部署名、両方足して『顧客名.pdf』になるようにしています pdfname1 = Range("a4").Text pdfname2 = Range("a5").Text '保存ファイル名及び保存場所の設定 fname = Application.GetSaveAsFilename("【御請求書】" & pdfname1 & " " & pdfname2 & " 御中", "PDFファイル,*.pdf") 'キャンセルボタン押下時 If fname = "False" Then Exit Sub 'ファイルの存在確認 If Dir(fname) <> "" Then rtn = MsgBox(fname & " が存在します。上書きしますか？", vbOKCancel + vbQuestion, "確認") 'キャンセルボタン押下時 If rtn = vbCancel Then Exit Sub End If '印刷順にシートを並び替え Worksheets("請求書").Move Before:=Worksheets("請求書ひな形") Worksheets("請求書").Select Worksheets("請求書ひな形").Select False Worksheets("請求書ひな形").Activate ' 請求書PDF出力 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fname MsgBox fname & " 出力完了" '元通りにシートを並び替え Worksheets("請求書ひな形").Move Before:=Worksheets("請求書") Worksheets("請求書ひな形").Select Dim sPath As String Dim mailTo As String Dim subject As String Dim preface As String Dim mailBody As String Dim attachPath As String sPath = """C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe"" -compose " '送信先アドレスはExcelのx1セルに反映 mailTo = Range("x1").Value subject = "御請求書の送付について" preface = pdfname1 & pdfname2 & " 御中" & vbNewLine & vbNewLine & "いつもお世話になります。" & vbNewLine & "御請求書をお送り致しますのでご確認下さい。" & vbNewLine & vbNewLine & "以上、宜しくお願い致します。" mailBody = preface '添付ファイルのパスはfnameではダメなんでしょうか？ attachPath = fname Shell sPath & "to=" & mailTo & ",subject=" & subject & ",body=" & mailBody & "," & "attachment=" & attachPath End Sub

お詳しい方宜しくお願い致します。 一番初めにコードを提供して頂けた方に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列のシートイベントを実行不可にしたいです。 良い方法はありませんでしょうか。