Visual Basic（VBA）(4ページ目)

VBAマクロでデータ集計の結果を出すマクロの記載方法を教えてほしい、この結果が出た時にフォントの色を変更したいがその時のVBAコードの組み方を教えてほしい、このエラーメッセージの解決方法を知りたい等こちらに参考情報があるかもしれません。

回答数

気になる

[vb.net] 起動したFrom2を閉じ、呼出元Form1の指定コントロールにカーソルをセット

こんにちは。いつもお世話になっております。タイトルの通りのことで悩んでいます。自作のPGで下記の処理を行っています。 ①Form1でForm2のインスタンスを作成する。 ②Form1をHideで非表示にする。 ③①のインスタンスをShowDialogで起動。 ④Form2を閉じて帰ってきた値がCancelならForm1をCloseする。→ここで終了 ⑤Form2を閉じて帰ってきた値がOKなら、Form1をshowで再表示する。 ⑥From1のtextbox1にカーソルをセットする。 ①～⑤まではうまくいくのですが、⑥のカーソルのセットがうまくいきません。「Me.show」の後に「Me.Activate()」などでForm1をアクティブにしてからフォーカスをセットしてもダメでした。フォーカスのセットは、「ActiveControl=textbox1」でも「textbox1.forcus」でもダメです。呼出元のForm1の指定コントロールにカーソルをセットする方法は何かないでしょうか。調べようにも、あまり当該内容がヒットせず見つかりません。ご存知の方がいましたら、宜しくお願い致します。

質問日時: 2024/07/02 10:57 質問者: nanigashi7

ベストアンサー

3

0
エクセルのマクロについて教えてください。

下記のマクロは先日教えて頂いたマクロです。実行すると作業ブック（コピー先）にコピー元のブックの指定範囲をコピペできます。 Dim Wb1 As Workbook Dim Wb2 As Workbook Sub 提出シートコピー削除() Call 提出シートを開く Call 提出シートコピー範囲 Call 貼り付け Call 電子提出削除 End Sub このマクロに「Call 住所コピー」を追加すると画像のエラーが表示されて、作業ブックの別シート（シート名：青紙表）のVBAコードの「With Worksheets("審査")」が黄色く表示されてマクロを連続して実行できませんでした。この問題の解決方法を教えてください。設定マクロ Dim Wb1 As Workbook Dim Wb2 As Workbook Sub 提出シートコピー削除() Call 提出シートを開く Call 住所コピー Call 提出シートコピー範囲 Call 貼り付け Call 電子提出削除 End Sub 住所コピーマクロ Sub 住所コピー() On Error Resume Next Dim Wb1, Wb2 Set Wb1 = Workbooks(1) 'このブック Set Wb2 = Workbooks(2) '別ブック 'セルの値を取得する Workbooks(1).Worksheets("受付").Range("L2") = Workbooks(2).Worksheets("FDデータ").Range("J49") End Sub シート「青紙表」のVBAコード Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$R$18" And IsNumeric(Cells(18, "R").Value) And Len(Cells(18, "R")) = 8 Then Application.EnableEvents = False Worksheets("青紙表").Range("$AX$3").Value = Worksheets("受付").Range("$J$2").Value Application.EnableEvents = True ActiveWorkbook.Save End If Sheets("青紙表").Select Range("$C$20").Select Sheets("Access").Visible = [AN46] = "●" On Error Resume Next If Range("$J$53").Value = "■" Then Call 構造 End If If Target.Address = "$C$23" Then Call 電子完了 End If If Range("$AB$35") <> "" Xor Range("AH35") <> "" Then Call 決済図形 End If If Range("$CO$7").Value = "有" Then Call 浄化槽表示 End If If Target.Address = "$O$28" Then Call 再修正表示 End If If Target.Address = "$O$28" Then Call 修正表示 End If If Target.Address = "$C$20" Then Call 審査担当コメント非表示 End If If Range("$EX$4").Value = "■" Then Call 消防通知図表示 End If If Range("$ER$3").Value = "■" Then Call 行政メール図表示 End If If Target.Address <> "$C$20" And Target.Address <> "$F$20" Then Exit Sub If Target.Address = "$C$20" And Range("$F$20").Value <> "" Then Exit Sub If Target.Address = "$F$20" And Range("$C$20").Value <> "" Then Exit Sub If Target.Value <> "" Then If True Then Call 新行政報告ファイルコピー Call 審査資料 Call 行政条例総合 Call いろはシステム Call シート300を非表示 On Error Resume Next Worksheets("受付").Visible = False Worksheets("管理表").Visible = False Worksheets("Access").Visible = False Worksheets("地方照会").Visible = False Worksheets("札幌道路").Visible = False Worksheets("札幌宅地").Visible = False Worksheets("札幌開発").Visible = False On Error Resume Next Application.DisplayAlerts = False Sheets("F審査").Delete Sheets("F設計INDX").Delete Application.DisplayAlerts = True End If Else On Error Resume Next Worksheets("受付").Visible = True Worksheets("管理表").Visible = True End If On Error Resume Next If Range("CI20").Value = "■" Then Call 日付 End If If Range("EY3").Value = "■" Then Call 消防通知図表示 End If End Sub 以上となります。よろしくお願いいたします。

質問日時: 2024/07/02 08:51 質問者: エクセル小僧

ベストアンサー

1

0
[VB.net] ボタン(Flat)のEnable時の背景色について

こんにちは。 VB.netを用いて簡単なプログラムを作っています。メニュー画面を作っており、ボタンをFlatにして背景色は白にしています。ログインするユーザーによって使うボタンを変更したいのですが、 Flatの特性なのか、Enable=falseであることがわかりにくいなと思いボタンの背景色をグレー等にできたらいいなと考えています。プロパティなども確認しましたが、方法が分からず困っています。もしご存知の方がいたらご教授願えませんでしょうか。宜しくお願い致します。

質問日時: 2024/07/01 15:32 質問者: nanigashi7

ベストアンサー

1

1
エクセルのマクロについて教えてください。

下記のマクロは教えて頂いたマクロです。コピー先にマクロを設定しており、マクロを実行するとコピー元のブックが開き、コピー範囲を指定して、コピー元の指定範囲にコピペ出来、その後、不要となったコピー元のブックを削除できます。しかし、コピペまでは上手く実行出来ましたが、不要ブックを削除できませんでした。解決方法を教えてください。 Sub Macro1() On Error Resume Next Dim folderPath As String Dim fileName As String folderPath = ThisWorkbook.Path & "\" fileName = Dir(folderPath & "*(提出用).xlsx") If fileName <> "" Then Workbooks.Open folderPath & fileName Else MsgBox "コピー元ファイルがありません", , "確認" Exit Sub End If Dim Wb1 As Workbook, Wb2 As Workbook Set Wb1 = Workbooks(1) 'このブック Set Wb2 = Workbooks(2) '別ブック 'セルの値を取得する Application.DisplayAlerts = False Application.EnableEvents = False Wb2.Worksheets("提出シート").Range("B1:H47").Copy Wb1.Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.CutCopyMode = False With Wb2 If .Name Like "#########-#*" Then If MsgBox(.Name & " を削除します", _ vbCritical + vbOKCancel, "警告！") = vbOK Then .Save .ChangeFileAccess Mode:=xlReadOnly Kill .FullName .Close (False) End If End If End With Application.EnableEvents = True Application.DisplayAlerts = True End Sub 以上となります。よろしくお願いいたします。

質問日時: 2024/07/01 15:23 質問者: エクセル小僧

ベストアンサー

2

0
エクセルのマクロについて教えてください。

下記のマクロを実行すると画像のエラーメッセージが表示されマクロ「貼り付け」のコードの内「Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats」が黄色く表示されて上手くマクロを実行できません。一連のマクロでは無く、手動で行うと上手く行きます。この問題を解決できる方法を教えてください。何時もの作業の手順として、マクロ設定ブック：コピー先を開く（手動）次にコピー元のブックを開く（手動）次にコピー元のコピー範囲を指定（手動）次にコピー先のブックに貼り付け（マクロ：貼り付け）を実行次にコピー元のブックの削除（マクロ：電子提出削除）を日々行っており、この手順だとエラーが出ずにコピー元の指定範囲をコピー先の指定範囲にコピー出来、コピー元のファイルを削除できます。しかし、一連のマクロだとエラーメッセージが表示されます。一連のマクロのままで上手くできる方法があるものですか？又、一連のマクロを一つのマクロとすると上手く行きますか？詳しく教えてください。よろしくお願いいたします。一連のマクロ Call 提出シートを開く Call 提出シートコピー範囲 Call 貼り付け Call 電子提出削除 End Sub それぞれのマクロ Sub 提出シートを開く() On Error Resume Next Dim folderPath As String Dim fileName As String folderPath = ThisWorkbook.Path & "\" fileName = Dir(folderPath & "*(提出用).xlsx") Do While fileName <> "" Workbooks.Open (folderPath & fileName) fileName = Dir() Loop End Sub Sub 提出シートコピー範囲() Dim Wb1, Wb2 Set Wb1 = Workbooks(1) 'このブック Set Wb2 = Workbooks(2) '別ブック 'セルの値を取得する Wb2.Worksheets("提出シート").Range("B1:H47").Copy End Sub Application.DisplayAlerts = False Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.DisplayAlerts = True End Sub Sub 電子提出削除() Dim wb As Workbook For Each wb In Workbooks With wb If .Name Like "#########-#*" Then If MsgBox(.Name & " を削除します", _ vbCritical + vbOKCancel, "警告！") = vbOK Then .Save .ChangeFileAccess Mode:=xlReadOnly Kill .FullName .Close (False) Exit For End If End If End With Next End Sub 以上となります。日々この作業を多い時で数十回行います。以前も同じような質問をしておりますが、解決には至っておりません。是非、解決方法を教えてください。よろしくお願いいたします。

質問日時: 2024/07/01 09:07 質問者: エクセル小僧

ベストアンサー

7

0
重複確認

下記のVBAコードを実行したら画像の様な結果になります。グループ２、３のように同じ時間がありますが片方が色がついてしまいます。グループ２なら両方色つけグループ３も1:06が２つあるのでそちらも色付したのですがどうすればいいでしょうか？どなたか詳しい方教えてください。 Sub 重複削除() Dim ws As Worksheet Dim iLastRow As Long Dim dict As Object Dim key As Variant Dim i As Long Dim maxRow As Long Dim maxTime As Date ' Set the worksheet Set ws = ThisWorkbook.Sheets("時系列") ' 必要に応じてシート名を変更してください ' Get the last row with data in column I iLastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row ' Create a dictionary to store the latest time for each value in column I Set dict = CreateObject("Scripting.Dictionary") ' Loop through column I to find duplicates and their latest time For i = 2 To iLastRow ' Assuming there is a header row If Not IsEmpty(ws.Cells(i, "I").Value) Then key = ws.Cells(i, "I").Value If dict.exists(key) Then ' Update the latest time if current time is newer If ws.Cells(i, "E").Value > ws.Cells(dict(key), "E").Value Then dict(key) = i End If Else dict.Add key, i End If End If Next i ' Highlight the rows with the latest time for each duplicate value For Each key In dict.keys maxRow = dict(key) ws.Rows(maxRow).Interior.Color = RGB(255, 255, 0) ' Yellow color Next key ' Clean up Set dict = Nothing End Sub

質問日時: 2024/06/30 12:17 質問者: ケイ0000

解決済

2

0
｛ CONTROL Forms.Label.1｝が表示されます

ワードでラベルコントロールを貼り付けると、本来ならキャプションが表示されるところ、上記の文字が表示されてしまいます。どうなっているのでしょうか。

質問日時: 2024/06/29 06:49 質問者: payphone

ベストアンサー

1

0
マクロの記録を使用したマクロの実行について

当方、マクロ・VBA初心者です。マクロの記録を利用し、マクロの作成を行いました。既にデータが入力されているセルに対して、・行の追加・列の追加・セルの結合を行うマクロの記録を行い、別シートにも同様の作業を反映させようとしたのですが、マクロを実行したところ、データが入力されているセルに対しては作業が反映されず、新規列・行が追加され、追加されたセルに対して作業が実行されました。マクロの記録を行ったシートと、作業を反映させたいシートは同様の構成となります。こちら、別シートの既存セルに対して作業を実行するにはどのようにしたらよいでしょうか。ご教示いただければ幸いです。 ▼マクロの記録で作成されたマクロ Sub Macro1() ' ' Macro1 Macro ' ' Columns("I:K").Select Range("I2").Activate Selection.EntireColumn.Hidden = False Columns("I:J").Select Range("I2").Activate Selection.ColumnWidth = 20 Columns("C:C").Select Range("C2").Activate Selection.Insert Shift:=xlToRight Rows("4:4").Select Selection.Insert Shift:=xlDown Rows("6:6").Select Selection.Insert Shift:=xlDown Rows("8:8").Select Selection.Insert Shift:=xlDown Rows("10:10").Select Selection.Insert Shift:=xlDown Rows("12:12").Select Selection.Insert Shift:=xlDown ActiveWindow.SmallScroll Down:=6 Rows("14:14").Select Selection.Insert Shift:=xlDown Rows("16:16").Select Selection.Insert Shift:=xlDown ActiveWindow.SmallScroll Down:=3 Rows("18:18").Select Range("C18").Activate Selection.Insert Shift:=xlDown ActiveWindow.SmallScroll Down:=-27 Rows("3:18").Select Selection.RowHeight = 32 Range("J2:K2").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Range("A3:A4").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ＜セル結合の繰り返しのため中略＞ Selection.Merge Range("T17:T18").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Range("A3:E18").Select Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$E3=""S""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent5 .TintAndShade = 0.799981688894314 End With Selection.FormatConditions(1).StopIfTrue = False Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$E3=""D""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 16764159 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$E3=""DP""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 16764159 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False End Sub

質問日時: 2024/06/28 17:20 質問者: chimchim_yumyum

ベストアンサー

2

0
エクセルのVBAコードについて教えてください。

作業ブックのシートに Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) 途中省略 If Range("$ER$3").Value = "■" Then Call Accessシート表示 End If End Sub を設定しております。指定セルに「■」が表示されるとマクロ「Accessシート表示」が実行されるのですが、作業の中で、マクロ「Accessシート非表示」を実行して「シート名：Access」を非表示にした後、同じシートの指定セル以外のセルを変更した場合にもマクロ「Accessシート表示」が実行されてAccessシート表示が表示されてしまいます。マクロ「Accessシート非表示」を変更して、一度、シート名：Accessを非表示にした後は、手動で表示にしない限り、このシートを非表示出来る方法があれば教えてください。現状のマクロ Sub Accessシート非表示() Worksheets("Access").Visible = False End Sub 以上となります。よろしくお願いいたします。

質問日時: 2024/06/28 11:33 質問者: エクセル小僧

ベストアンサー

6

0
VBAでCOPYを繰り返すと、処理が途中でアイドルする原因はなんでしょうか

A列からE列までの5列で約3000行のデータがあります。これらのデータは2つのグループのデータが混在しています。それをグループ毎に振り分ける処理を作成しました。処理は正常に動作したのですが、処理に数分程度かかりました。そこで50行毎の処理時間をセルに表示させるようにしたところ、700行程度までは数秒で処理できていますが、その後1分程度、処理がアイドルしています。その後また700～800行を数秒で処理し、またアイドルするの繰り返しでした。解決策は見つけましたが、処理がアイドルする原因は何として考えられるか、教えていただけませんか。これまでこのような現象は経験がなく、気になっています。よろしくお願いいたします。問題のステートメント Cells(idx, 1).Resize(1, 5).Copy Destination:=Cells(cntA, 7).Resize(1, 5) Application.CutCopyMode = False　' ← この行は、あってもなくても現象は変わらないなおCopyメソッドをやめて、地道に転記してみたら10秒程度で全ての処理が終わりました。 Cells(cntA, 7) = Cells(idx, 1) Cells(cntA, 8) = Cells(idx, 2) Cells(cntA, 9) = Cells(idx, 3) Cells(cntA, 10) = Cells(idx, 4) Cells(cntA, 11) = Cells(idx, 5) Windows10　Office Professional Plus 2019　です。

質問日時: 2024/06/27 13:21 質問者: zap35

ベストアンサー

4

1
vbaにてseleniumを使用したedgeスクレイピング

vbaにて selenium basicを使用して edgeブラウザを操作しようとしています。 vbaからedgeを起動しようとしていますが vbaにて、Selenium.Webdriverをnewする行で、オートメーションエラー('-2146・・・')となります。 ◆下記、手順を実施 1)SeleniumBasic-2.0.9.0インストール 2).net Framework3.5有効化 3)edgedriverダウンロード　seleniumのフォルダに上書き　＊バージョンは使用中のedgeブラウザの　　バージョンと同じにしてます 4)vba の参照設定追加　Selenium Type Libraryをチェック 5)vbaコード作成と実行　sub 　　Dim driver As Selenium.WebDriver 　　Set driver = new Selenium.WebDriver 　　driver.Start "edge" 　End Sub ◆実行環境 Windows Home 11 23H2 64bit excel 2003 ◆補足・手順4の参照設定画面にて　Selenium Type Libraryの場所に表示される　ファイル名がselenium32.tlb(selenium64.tlbではない) 　とあり、気になりますが、変更できませんでした。　seleniumのフォルダにはselenium64.tlbも存在はしています。

質問日時: 2024/06/27 11:09 質問者: ゆu

解決済

1

0
VBの色を変えるにはどうしたらいいですか？

VBの色を変えるにはどうしたらいいですか？

質問日時: 2024/06/25 12:47 質問者: あっきー126

ベストアンサー

3

0
テキストファイルのフィールド行のみ削除したい

CSVファイルのフィールド行のみを削除する方法を教えてください。 PADからの実行で実行可能なスクリプトは以下です。・DOSコマンド・VBScript ・JavaScript ・Python これらであればどれを使用しても大丈夫です。よろしくお願いします。

質問日時: 2024/06/25 11:20 質問者: Mehco3

解決済

2

0
Excel(M365) Vlookup/セル反転(VBA)について

・Excel(M365)で、添付ファイルのようなVLOOKUP処理を作りたい（VBAで）のですが、作り方についてお教えいただけませんでしょうか・具体的に実施したいこととしては、①Sheet1のE列と、Sheet2のC列をマッチングし、Sheet1のJ列の値を、Sheet2のM列へ転記する。その際、Sheet1にデータ重複している場合（例：CCC,DDD）、そのデータの最下行の値を転記する（例：CCC→400、DDD→700）②この重複データについては、アラームのため、該当するSheet2のB~C列を赤くセル反転させる。・上記マッチングしない場合は、Sheet2へは特に転記はしない（例：EEE）・何卒、よろしくお願いします。

質問日時: 2024/06/24 08:11 質問者: mame1216

ベストアンサー

1

0
Excel 範囲指定スクショについて Excelで範囲指定してスクリーンショットする機能がありますが

Excel　範囲指定スクショについて Excelで範囲指定してスクリーンショットする機能がありますが、自動化する方法はありますでしょうか？流れとしては下記のような順序になります。スクショ写真を貼り付けるセルを選択 ※ここはまだ手動です。 ↓ 自動:範囲指定のスクショ機能を動作させる ↓ 自動:範囲指定した箇所をスクショ ※指定する範囲は毎回同じです。 ↓ 自動:選択しているセルに貼り付け文頭に(自動:)とついている文が自動化させたいところです。分かる方いましたら、ご回答お願いします

質問日時: 2024/06/22 22:07 質問者: ピーマンナッツ

解決済

1

0
Excelのマクロについて教えてください。

下記のマクロを実行すると連続して指定マクロが実行されます。しかし、マクロ「フォルダコピー新規」を実行した後に「戸建てファイルコピー」を実行するとそれぞれ保存先を聞いてきます。マクロ「戸建てファイルコピー」の場合は保存先を聞いてこず、「フォルダコピー新規」で指定したフォルダ内に保存出来る方法を教えてください。現状のマクロ Sub 新規引き受け() Call フォルダコピー新規 Call 戸建てファイルコピー End Sub それぞれのマクロ Sub 戸建てファイルコピー() Const FileNewName As String = "総合引き受け（戸建て）" Dim Destinationfolder As Variant With Application.FileDialog(msoFileDialogFolderPicker) .Title = "保存先フォルダを選択してください" .InitialFileName = "\\nas-sp01\share\確認部\電子申請　関連\１．受付\１．確認申請\" If .Show = False Then Exit Sub Destinationfolder = .SelectedItems(1) End With Dim SourceFile As String Dim Extension As Variant For Each Extension In Array(".xlsm", ".xltm") SourceFile = "\\nas-sp01\share\確認部\電子申請　関連\１．受付\１．確認申請\審査用フォルダ\総合引き受け（戸建て）" & Extension Dim DestinationFile As String DestinationFile = Destinationfolder & "\" & FileNewName & Extension On Error Resume Next FileCopy SourceFile, DestinationFile On Error GoTo 0 Next End Sub と Sub 戸建てファイルコピー() Const FileNewName As String = "総合引き受け（戸建て）" Dim Destinationfolder As Variant With Application.FileDialog(msoFileDialogFolderPicker) .Title = "保存先フォルダを選択してください" .InitialFileName = "\\nas-sp01\share\確認部\電子申請　関連\１．受付\１．確認申請\" If .Show = False Then Exit Sub Destinationfolder = .SelectedItems(1) End With Dim SourceFile As String Dim Extension As Variant For Each Extension In Array(".xlsm", ".xltm") SourceFile = "\\nas-sp01\share\確認部\電子申請　関連\１．受付\１．確認申請\審査用フォルダ\総合引き受け（戸建て）" & Extension Dim DestinationFile As String DestinationFile = Destinationfolder & "\" & FileNewName & Extension On Error Resume Next FileCopy SourceFile, DestinationFile On Error GoTo 0 Next End Sub になります。宜しくお願い致します。

質問日時: 2024/06/21 09:31 質問者: エクセル小僧

ベストアンサー

4

0
プログラミング

おはようございます。今日もB型事業所に通う私です。アイスコーヒーを飲んでいます。最近、エクセルVBAを始めたのですが楽しいです。プログラミングって楽しいですよね？

質問日時: 2024/06/20 07:01 質問者: ともこん

ベストアンサー

6

0
エクセルVBAコードで教えて下さい！

現在、 Sub 円楕円1_Click() Dim i As Range Set i = ActiveCell With ActiveSheet.Shapes.AddShape(msoShapeOval, i.Left, i.Top, i.Width, i.Height) .Fill.Visible = False .Line.ForeColor.RGB = RGB(0, 0, 0) End With Set i = Nothing End Sub 上記コードで該当（土日）に〇を付けて編集しています。このコードを結合したセルにも使えるようにするには、どのようにコードを編集すれば良いでしょうか？ご教授のほどよろしくお願いいたします。

質問日時: 2024/06/18 17:28 質問者: TAKA0315m

ベストアンサー

1

0
VBAコードについて教えてください。

作業ブックのシートに下記のコードを設定しております。このコードは指定セルに("地番調査", "許可証")のどちらかの文字が表示された場合に文字が表示された右横のセルに「後日図書の提出をお願いいたします。」と表示されます。このコードを変更して指定セルに不特定な文字が表示された場合に右横のセルに「後日図書の提出をお願いいたします。」と表示出来る方法を教えてください。現状のコード Private Sub Worksheet_Change(ByVal Target As Range) If Target.CountLarge > 1 Then Exit Sub If Intersect(Target, Range("C26:C31")) Is Nothing Then Exit Sub Dim arr1, arr2 arr1 = Array("地番調査", "許可証") Dim i As Long For i = 0 To UBound(arr1) If Target.Value = arr1(i) Then Target.Offset(, 3).Value = "後日図書の提出をお願いいたします。" Exit Sub End If Next i End Sub 以上です。宜しくお願い致します。

質問日時: 2024/06/18 13:51 質問者: エクセル小僧

ベストアンサー

2

0
Excelのマクロについて教えてください。

下記のマクロはネットで調べたコードを自分用にアレンジした、マクロです。このマクロを実行すると、マクロ設定ブックと同じフォルダ内にある、別ブックの指定シートの指定セル値を作業ブックにコピぺできます。しかし、マクロを実行すると、画像のエラーメッセージが表示され、作業ブックのコピー先のシート「受付」に設定しているVBAコード「With Worksheets("審査")」が黄色く変色してしまいます。このコード全体では Private Sub Worksheet_Change(ByVal Target As Range) Dim tbl As Variant Dim i As Integer Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False tbl = Array("D10", "D11", "E10", "E11", "F10", "F11") With Worksheets("審査") For i = 0 To 5 .Range("C" & 26 + i).Value = Range(tbl(i)).Value If Range(tbl(i)).Value = "" Then .Range("F" & 26 + i).Value = "" Else .Range("F" & 26 + i).Value = "後日図書の提出をお願いいたします。" End If Next i End With 以下省略 End Sub となっており、指定セル値に文字が表示されれば、シート名「審査」の指定セルに「後日図書の提出をお願いいたします。」と表示出来るようになっております。この問題を解決できる方法を教えてください。現状のマクロ Sub Macro1() Dim FilePath As String 'ファイルの入っているフォルダをパスを設定 FilePath = ThisWorkbook.Path 'コピー元のブックを開く Workbooks.Open FilePath & "\テスト(提出用).xlsx" 'データをコピー Workbooks("テスト(提出用).xlsx").Worksheets("提出シート").Range("B2:H47").Copy _ Workbooks("総合引き受け（1-1）（知恵袋）.xlsm").Worksheets("受付").Range("B2") 'コピー元のブックを閉じる(セーブしない) Workbooks("テスト(提出用).xlsx").Close savechanges:=False End Sub 以上となります。宜しくお願い致します。

質問日時: 2024/06/18 09:20 質問者: エクセル小僧

ベストアンサー

1

0
vba アクティブシートの名前変更について教えてください

いつもお世話になります今同じシート名の存在を確認して、同じ名前のシート名が有る時は削除してからシートを追加し、名前を変更するステートメントを作成しています　　　　　File2="WC(品)" For Each ws In Worksheets If ws.Name = FILE2 Then Application.DisplayAlerts = False Worksheets(ws.Name).Delete Application.DisplayAlerts = True Exit For End If Next ws Worksheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = FILE2 既存のシートには前回作った"WC（品）"が有ったのですがシートの有無チェックには掛からずに下記のエラーが発生しましたエラー："この名前は既に使用されています。別の名前を入力してください" エラーが出たときはちょっとびっくりしました。今はStrConvを使ってエラーを回避させていますがちょっと気に掛かるので教えてください ActiveSheet.Nameは全角と半角の区別は出来ないのでしょうか？以上、よろしくお願い申しあげます

質問日時: 2024/06/17 12:27 質問者: 公共ごま

ベストアンサー

3

0
Excelのマクロについて教えてください。

作業ブックに連続して実行できるマクロを設定しております。 Sub 貼り付け総合() Call 提出シートを開く Call 提出シートコピー範囲 Call 貼り付け End Sub このマクロを実行すると画像のエラーが表示されて、マクロ：「貼り付け」のコードの「Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats」が黄色く表示されて、上手くマクロが実行できません。例えば、「Call 提出シートを開く」・「Call 提出シートコピー範囲」のマクロをやめて手動でコピー元のブックを開き、コピー範囲をマウスで設定して「Ctrl+C」を行い作業ブック側の「Call 貼り付け」を実行するとコピペが上手く行きます。問題の解決方法を教えてください。現状のマクロ Sub 提出シートを開く() On Error Resume Next Dim folderPath As String Dim fileName As String folderPath = ThisWorkbook.Path & "\" fileName = Dir(folderPath & "*(提出用).xlsx") Do While fileName <> "" Workbooks.Open (folderPath & fileName) fileName = Dir() Loop End Sub Call 提出シートコピー範囲 Dim Wb1, Wb2 Set Wb1 = Workbooks(1) 'このブック Set Wb2 = Workbooks(2) '別ブック 'セルの値を取得する Wb2.Worksheets("提出シート").Range("B1:H47").Copy End Sub Sub 貼り付け() Application.DisplayAlerts = False Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.DisplayAlerts = True Sheets("受付").Range("H60").Copy Sheets("受付").Range("F24").PasteSpecial xlPasteValues Sheets("受付").Range("Q10").Copy Sheets("受付").Range("F12").PasteSpecial xlPasteValues End Sub 以上となります。よろしくお願いいたします。

質問日時: 2024/06/14 16:38 質問者: エクセル小僧

ベストアンサー

2

1
エクセルのマクロについて教えてください。

下記のマクロは別ブックの指定セル値を作業ブックに貼り付け出来るマクロとなっております。この貼り付けを画像のように「値の貼り付け」「値と数値の書式（A）で貼り付けが出来る方法を教えてください。現状のマクロ Sub 貼り付け() Application.DisplayAlerts = False Worksheets("受付").Range("B1:H47").PasteSpecial Paste:=xlPasteValuesAndNumberFormats Application.DisplayAlerts = True End Sub 以上となります。よろしくお願いいたします。

質問日時: 2024/06/14 12:16 質問者: エクセル小僧

ベストアンサー

1

0
Excelのマクロについて教えてください。

コピー先のマクロ設定作業ブックを「Set Wb1 = Workbooks(1) 'このブック」としておりコピー元のブックを「Set Wb2 = Workbooks(2) '別ブック」としております。現状では、コピー元のシート名「提出シート」のセル範囲「B1：H47」を手動で B1にセルからH47にセルを合わせて「Ctrl+C]を押してコピー範囲を指定しております。この作業をコピー先の作業ブック「Set Wb1 = Workbooks(1) 'このブック」にマクロを設定できる方法を教えてください。一番最初に「Set Wb1 = Workbooks(1) 'このブック」を開き、次に「「Set Wb2 = Workbooks(2) '別ブック」を開いております。新設にコード共、教えてください。よろしくお願いいたします。

質問日時: 2024/06/13 15:48 質問者: エクセル小僧

ベストアンサー

1

0
Excelのマクロについて教えてください。

下記のマクロを実行すると他のブックの指定範囲を作業ブックの指定範囲にコピペできます。このマクロだとコピー元のセル値に設定している数式を文字としてコピーしてしまいます、このコードを変更してコピペした場合に、コピー元のセル値に表示した文字及び数式をコピー先にコピペ出来る方法を教えてください。現状のマクロ Sub 提出シート貼り付け() Dim Wb1, Wb2 Set Wb1 = Workbooks(1) 'このブック Set Wb2 = Workbooks(2) '別ブック 'セルの値を取得する Wb2.Worksheets("提出シート").Range("B1:H37").Copy Wb1.Worksheets("受付").Range("B1:H37") End Sub 以上です。よろしくお願いいたします。

質問日時: 2024/06/13 13:39 質問者: エクセル小僧

ベストアンサー

1

0
Excelのマクロについて教えてください。

下記のマクロを実行するとマクロを設定しているブックと同じフォルダ内にあるファイルを開く事が出来ます。ファイル名「前青紙.xlsx」この部分をワイルドカードで「*(提出用).xlsx」に変更する方法を教えてください。現状のマクロ Sub ブックを開く2() On Error Resume Next Workbooks.Open Filename:=ThisWorkbook.Path & "\前青紙.xlsx" End Sub 以上です。よろしくお願いいたします。

質問日時: 2024/06/13 10:35 質問者: エクセル小僧

ベストアンサー

2

0
Excelのマクロについて教えてください。

下記のマクロを実行すると指定のファイルのデーターを作業ブックの指定シートに貼り付けが出来るようにしております。作業ブックでこのマクロを実行するとかなりの時間がかかります（20秒程度）この時間を短縮できる方法があれば教えてください。現状のマクロ Sub データコピペ() Dim expressionRng, destinationRng Dim n 'コピー元のファイルを開く Workbooks.Open ActiveWorkbook.Path & "\" & "FDﾃﾞｰﾀ.xlsx" Set expressionRng = Workbooks("FDﾃﾞｰﾀ.xlsx").Sheets("Sheet1").Range("$A$1:$OZ$12") Set destinationRng = ThisWorkbook.Sheets("FDデータ").Range("$A$1:$B$2") For n = 1 To expressionRng.Rows.Count destinationRng(n, 1).RowHeight = expressionRng(n, 1).RowHeight Next For n = 1 To expressionRng.Columns.Count destinationRng(1, n).ColumnWidth = expressionRng(1, n).ColumnWidth Next expressionRng.Copy destinationRng Workbooks("FDﾃﾞｰﾀ.xlsx").Close Kill ActiveWorkbook.Path & "\" & "FDﾃﾞｰﾀ.xlsx" End Sub よろしくお願いいたします。

質問日時: 2024/06/13 08:57 質問者: エクセル小僧

ベストアンサー

5

0
久しぶりのプログラミング

おはようございます。今日もB型事業所に通う私です。昨日からエクセルVBAを始めました。私にとっては久しぶりのプログラミングです。大学行って、専門学校でプログラマを目指していたので、比較的やりやすいです。私は当時、C言語を学んでいたのですがそれに比べるとVBAは楽と言うか始めたばかりなのでわかりませんがやりやすいです。今、Cをやるとするとコンパイラがないし、かなり忘れています。 VBAはエクセルなので特別なソフトがいらないのでいいです。普段、エクセルは実用的に表などを作っているので、VBAプログラミングは趣味のようなものです。プログラミングって楽しいですよね！！やっている方どうですか？

質問日時: 2024/06/13 06:56 質問者: ともこん

ベストアンサー

4

1
エクセルVBA

つい先ほど、久しぶりに本を見つけました。エクセルVBAの本です。古い本でしたがサンプルファイルはダウンロードしてありました。私は、プログラミングは正直、C言語とHTMLがある程度出来るのでなんとなくコツはつかみました。エクセルを最初からVBEで入力し、デバックして実行し、マクロすれば良いのですよね？詳しい方、教えてください。

質問日時: 2024/06/12 19:38 質問者: ともこん

ベストアンサー

3

0
Excelのマクロについて教えてください。

下記のマクロは先日教えて頂いた、マクロです。コピー元の指定フォルダ内の指定ファイル名「■北海道_20230731更新.pdf」の「_20230731更新」この部分が点検終了日付をしてしており、都度、変更になります。ワイルドカードを利用して「■北海道*」をコピー先にコピー出来る方法を教えてください。又、コピー後は元のファイル名+「_Copy.pdf」となるようにお願いいたします。現状のマクロ Sub 北海道条例() On Error Resume Next Dim targetCities As Variant Dim city As String Dim isExcluded As Boolean Dim copyFilePath As String Dim destinationFilePath As String ' 特定の都市名リスト targetCities = Array("旭川市", "釧路市", "札幌市", "室蘭市", "小樽市", "帯広市", "苫小牧市", "函館市", "北見市") ' セル F3 の都市名を取得 city = Sheets("受付").Range("F3").Value ' 都市名がリストに含まれているかどうかをチェック isExcluded = False For Each c In targetCities If city = c Then isExcluded = True Exit For End If Next c ' リストに含まれていない場合 If Not isExcluded Then ' コピー元のファイルパス copyFilePath = "\\nas-sp01\share\確認部\■共通\審査の注意点\条例・細則【確認申請添付】\■北海道_20230731更新.pdf" ' コピー先のファイルパス destinationFilePath = ThisWorkbook.Path & "\■北海道_20230731更新_Copy.pdf" ' ファイルをコピー FileCopy copyFilePath, destinationFilePath End If End Sub 以上となります。よろしくお願いいたします。

質問日時: 2024/06/12 10:41 質問者: エクセル小僧

ベストアンサー

1

0
Excelのマクロについて教えてください。

Excelのマクロについて教えてください。下記のマクロは先日教えて頂いたマクロです。このマクロを利用して下記のように変更出来る方法を教えてください。セル「F3」に「旭川市・釧路市・江別市・札幌市・室蘭市・小樽市・帯広市・苫小牧市函館市・北見市」以外の表示があった場合は、コピー元のファイル「■北海道北海道_20230731更新」が作業フォルダ内にコピー出来る方法を教えてください。例えば、F3に「北広島市」と表示されるとフォルダ内に「■北海道_20230731更新_Copy.pdf」がコピー出来る方法を教えてください。現状のマクロ Sub 条例() On Error Resume Next If Sheets("受付").Range("F3").Value <> "" Then Const copy_path As String = "\\nas-sp01\share\確認部\■共通\審査の注意点\条例・細則【確認申請添付】\" Dim strSource As String strSource = Dir(copy_path & "■" & Sheets("受付").Range("F3").Value & "*.pdf") FileCopy copy_path & strSource, _ ThisWorkbook.Path & "\" & Mid(strSource, 1, InStrRev(strSource, ".") - 1) & "_Copy.pdf" End If End Sub 以上となります。よろしくお願いいたします。

質問日時: 2024/06/11 17:23 質問者: エクセル小僧

ベストアンサー

1

0
VBAなくなるの？

VBAがなくなる、使えなくなると言う記事なりユーチューブを見たのですが本当でしょうか？今でも仕事でVBAを使っているのですが使用できなくなるってこと？もしそうなら今後はなにで代用できますか？詳しい方いれば教えて下さい。早めに勉強しようと思いますので勉強方法なども教えてくださると助かります。

質問日時: 2024/06/09 11:28 質問者: ケイ0000

ベストアンサー

3

0
vba 削除

質問ですシートに値の一覧が複数あります。それを条件に基づいて行を削除したいです。条件ですが画像の２行目、３行目のようにa2、b2、c2、a3、b3、c3セルの内容が同じでd2が空白、d3は文字が入っています。この2行がペアでe列が両方okなら合格で5行目、6行目のように片方にngがあればそのペアは不合格です。この条件でシートに一覧で並んでいるものを振り分けて不合格ならそのﾍﾟｱの両方の行を削除するVBAを作りたいです。初めはngを検索して削除していたのですがそれだとokが残ってしまいますがペアで揃って合格なので一つだけしかないものも削除したいです。説明が難しいのとヘタでわかりにくいと思いますが、理解してくださった方おられれば教えて下さい

質問日時: 2024/06/04 21:05 質問者: ケイ0000

解決済

3

0
Geogebraの操作方法について

Geogebraにおいて、写真のように変数のもつ値に対応して、aの値が変わるような式のテキストを作成したいです。見よう見まねで作っても、[a]としか表示されず、変数として表示が反映されません。どうすればいいのでしょうか

質問日時: 2024/06/01 11:13 質問者: みなゆう

解決済

1

0
ExcelのVBAコードについて教えてください。

Private Sub Worksheet_Change(ByVal Target As Range) Dim tbl As Variant Dim i As Integer Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False tbl = Array("D10", "D11", "E10", "E11", "F10", "F11") With Worksheets("審査") For i = 0 To 5 .Range("C" & 26 + i).Value = Range(tbl(i)).Value If Range(tbl(i)).Value = "" Then .Range("F" & 26 + i).Value = "" Else .Range("F" & 26 + i).Value = "後日図書の提出をお願いいたします。" End If Next i End With On Error Resume Next Sheets("消防添").Visible = [R37] = "消防添" 途中省略 Sheets("INDX").Visible = [D2] = "電子申請" 下記のコードもいくつか途中省略しております。 If Range("D2").Value = "紙申請" Then Call 電図 Else Call 紙図 End If If Range("N41").Value = "■" Then Call 注意1表示 End If If Range("D7").Value = "計画変更" Then Call 注意3表示 End If If Range("N44").Value = "■" Then Call 注意4表示 End If If Range("D5").Value = "車庫等：単独" Then Call 車庫単独 End If If Range("R55").Value = "車庫注意" Then Call 車庫単独 End If If Range("D7").Value = "計画変更" Then Call 計変画像表示 End If If Range("Q27").Value = "■" Then Call 区分図形表示 End If If Range("D12").Value = "有" Then Call 消防表示 End If If Range("F13").Value = "有" Then Call 浄化槽表示 End If If Range("F8").Value >= 3 Then Call 通路 End If If Range("J16").Value = "消防同意必要" Then Call 消防貼り付け End If If Range("Q2").Value = "■" Then Call 市町村名コピー End If If Range("F3").Value = "旭川市" Then Call 旭川市図形表示 End If If Target.Address = "$C$20" Then Call 審査担当コメント非表示 End If Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.EnableEvents = True End Sub 以上となります。

質問日時: 2024/05/29 16:59 質問者: エクセル小僧

ベストアンサー

5

0
VBA指定行削除

下記のVBAで・a列の最終行までの重複しているその行全体を削除・b列の最終行までの「NG」と「中断」がある行全体を削除したいのですがうまくいきません。どこにどのようにしたらできるでしょうか？ a列のの重複だけ削除されていて他の行が残ったりします。詳しい方教えて下さい。お願いします。 Sub 一覧() Dim lastRow As Long Dim sourceRange As Range Dim destinationRange As Range Dim firstUnderscorePos As Integer Dim lastUnderscorePos As Integer Dim valueBeforeUnderscore As String Dim valueAfterUnderscore As String ' シート１で最終行を取得 lastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).row ' シート１でA2から最終行までの範囲を選択 Set sourceRange = Sheets("Sheet1").Range("A2:A" & lastRow) ' シート２のA1セルから貼り付け Set destinationRange = Sheets("Sheet2").Range("A1") ' 最初の"_"部分までをA列に、最後の"_"部分のあとをB列に貼り付け For Each cell In sourceRange valueBeforeUnderscore = "" valueAfterUnderscore = "" ' "_"の位置を取得 firstUnderscorePos = InStr(1, cell.value, "_") lastUnderscorePos = InStrRev(cell.value, "_") ' "_"が存在する場合 If firstUnderscorePos > 0 And lastUnderscorePos > 0 Then ' "_"の前の部分を取得 valueBeforeUnderscore = Mid(cell.value, 1, firstUnderscorePos - 1) ' "_"の後の部分を取得 valueAfterUnderscore = Mid(cell.value, lastUnderscorePos + 1) End If ' ".xlsx"を削除 valueBeforeUnderscore = Replace(valueBeforeUnderscore, ".xlsx", "") valueAfterUnderscore = Replace(valueAfterUnderscore, ".xlsx", "") ' A列に貼り付け destinationRange.value = valueBeforeUnderscore ' B列に貼り付け destinationRange.Offset(0, 1).value = valueAfterUnderscore ' 次の行に移動 Set destinationRange = destinationRange.Offset(1, 0) Next cell End Sub

質問日時: 2024/05/26 10:02 質問者: ケイ0000

解決済

2

1
VBA一覧取得再投稿

下記のVBAでエクセル名の取得できるところまでは作成できています。このVBAで一覧にしてそのシート上でそのエクセルファイルを開きたいのですができるでしょうか？エクセル名とパスを取得する感じできるでしょうか？詳しい方教えてください。最終的には名前で検索をかけて2つのファイルを開きたいと思っています。ご意見よろしくお願いします Sub GetExcelFileNames() Dim folderPath As String Dim fileName As String Dim row As Long ' フォルダーのパスを指定 folderPath = "C:\YourFolderPath\" ' ここに対象フォルダーのパスを記入 ' フォルダーのパスがバックスラッシュで終わっているか確認 If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" End If ' 初期設定 fileName = Dir(folderPath & "*.xls*") ' フォルダー内のExcelファイルを取得 row = 1 ' アクティブシートをクリア Cells.Clear ' ファイル名を取得してシートに書き込む Do While fileName <> "" Cells(row, 1).Value = fileName row = row + 1 fileName = Dir Loop ' 終了メッセージ MsgBox "ファイル名の取得が完了しました。", vbInformation End Sub

質問日時: 2024/05/25 12:28 質問者: ケイ0000

解決済

1

0
エクセルVBAについて

エクセルファイルをダイヤログを表示させて名前を付けて保存したいのですが、以下のコ－ド、' A列の最終行の数字を取得 lastRow = ThisWorkbook.Sheets(1).Cells(ThisWorkbook.Sheets(1).Rows.Count, 1).End(xlUp).Valueの部分で型が一致しませんとエラーメッセージが出ます。エラーメッセージを出さずに保存するにはどこを修正すればよいのでしょうか？どなたかご教示願います。よろしくお願いいたします。 Sub ファイル保存() Dim folderPath As String Dim fileName As String Dim dateStr As String Dim c3Content As String Dim d3Content As String Dim e3Content As String Dim f3Content As String Dim customName As String Dim lastRow As Long Dim formattedF3Content As String Dim formattedCombinedContent As String ' 保存先フォルダのパスをダイアログで選択 folderPath = "C:\Users\t-tai\OneDrive\デスクトップ\図番" ' A列の最終行の数字を取得 lastRow = ThisWorkbook.Sheets(1).Cells(ThisWorkbook.Sheets(1).Rows.Count, 1).End(xlUp).Value ' 今日の日付を文字列に変換 dateStr = Format(Date, "yyyymmdd") ' 各セルの内容を取得 c3Content = ThisWorkbook.Sheets(1).Range("C3").Value d3Content = ThisWorkbook.Sheets(1).Range("D3").Value e3Content = ThisWorkbook.Sheets(1).Range("E3").Value f3Content = ThisWorkbook.Sheets(1).Range("F3").Value ' F3セルの内容をフォーマット（4桁の内容があるが左から2行目の後に-を挿入） If Len(f3Content) >= 4 Then formattedF3Content = Left(f3Content, 2) & "-" & Mid(f3Content, 3, 2) Else MsgBox "F3セルの内容が正しくありません。4桁の内容を含めてください。" Exit Sub End If ' C3、D3、E3、F3セルの内容をフォーマット formattedCombinedContent = c3Content & "-" & d3Content & "-" & e3Content & "-" & formattedF3Content ' カスタムファイル名を作成 customName = dateStr & "(" & formattedCombinedContent & ")他" & lastRow & "件" ' ファイルの保存先パスを作成 fileName = folderPath & "\" & customName ' ファイルを保存 With Application.fileDialog(msoFileDialogSaveAs) .Title = "保存先フォルダを選択してください" .InitialFileName = fileName & ".xlsm" .AllowMultiSelect = False If .Show <> -1 Then MsgBox "保存先フォルダが選択されませんでした。", vbExclamation Exit Sub End If .Execute MsgBox "ファイルが保存されました。", vbInformation End With End Sub

質問日時: 2024/05/23 01:13 質問者: Wrangleruk

ベストアンサー

1

0
VBA 複数のエクセルから一つのエクセルに貼り付ける

画面に開いている複数のエクセルをコピーして、別のエクセルに一つのデータにしたい場合、どのような式を書けばいいですか？

質問日時: 2024/05/21 19:09 質問者: stop-stop

解決済

1

0
【ExcelVBA】値を変更しながら連続でPDFを作成し，それらを結合した状態で出力するコード

office365を使用しています。１行に１件ずつデータが入っているExcelファイルで，I２セルからI3セルで指定した範囲の行のデータを「様式」シートに順番に反映させながら，連続してPDFを作成するコードを以下のように作成しております。以下のコードだと，PDFファイルが１件（１行）につき，一つずつ作成されますが，１つのファイルとして結合した状態で出力させるにはどのようなコードにしたら良いか，ご教示いただけないでしょうか。おそらく，クリップボードのようなところで，１件（１行）のデータを様式シートに反映させたらそれを保存し，順次，次の行のデータを反映させてクリップボード上のデータに追加していくという動きのコードになると思うのではないかと思うのですが，調べてもわかりませんでした。 Sub 連続PDF作成() Dim i As Long Dim j, k As Long Dim l As String Dim myfolder As String Application.ScreenUpdating = False myfolder = ThisWorkbook.Path + "\" j = Worksheets("回答").Range("I2").Value k = Worksheets("回答").Range("I3").Value For i = j To k Worksheets("回答").Range("A5").Value = Worksheets("回答").Cells(i + 9, 1).Value l = Sheets("回答").Range("N6").Value & "・" & Sheets("回答").Range("G6").Value & "・" & Sheets("回答").Range("D6").Value Worksheets("様式").Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myfolder & "回答\" & l & ".pdf", OpenAfterPublish:=False, IgnorePrintAreas:=False Next i Application.Goto Sheets("回答").Range("A5") Application.ScreenUpdating = True End Sub

質問日時: 2024/05/20 10:43 質問者: qazxcvfr4

ベストアンサー

3

0
【マクロ】１つのマクロの中に、ブック指定とシート指定が混在しても良いのですか？

【質問したい事】下記の【２つめのマクロ】について同じブック内で動かすコードです３行あり、１行目はブック指定。２・３行目はシート指定です。全て同じブック内です。このような書き方は適切でしょうか？ ※次のコードの事です　Workbooks("いろいろあり転記元.xlsm").Worksheets("画面貼付").Activate なお、当該マクロの前に別ブックにて別マクロが動いた後に当該マクロのブックに移動をして、実行する為、シートとのみ書いていると動きませんでした。よって、１行目だけブック・シートに変更したところ動きました質問は同じマクロ内で、ブックとシートが混在してよいですか？です宜しくお願いしますなお、下記のマクロは全て動きます Workbooks("いろいろあり転記元.xlsm").Worksheets("画面貼付").Activate 【下記の２つのマクロを呼出。実行】 Sub call() Call 別ブックへ転記ファイル名変更 Call 列クリア End Sub 【１つめのマクロ】 Sub 別ブックへ転記ファイル名変更() Dim ws1 As Worksheet Dim wb2 As Workbook Dim ws2 As Worksheet Dim maxrow2 As Long Dim row2 As Long Set ws1 = Worksheets("転記元") Set wb2 = Workbooks.Open(ws1.Range("A3").Value)　'ブックパス Set ws2 = wb2.Worksheets(ws1.Range("A5").Value)　'上記のシート名 maxrow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row row2 = maxrow2 + 1 ws2.Cells(row2, 1).Resize(1, 3).Value = ws1.Cells(1, 1).Resize(1, 3).Value End Sub 【２つめのマクロ】⇒質問したいコード Sub 列クリア() Workbooks("いろいろあり転記元.xlsm").Worksheets("画面貼付").Activate Worksheets("画面貼付").Columns("d").Clear Worksheets("転記元").Activate End Sub

質問日時: 2024/05/16 07:13 質問者: aoyama-reiko

ベストアンサー

2

0
VBA ユーザーフォームボタンクリック後にセルにフォーカス

VBAのユーザーフォームについて質問です。ユーザーフォーム上のコマンドボタンをクリックすると、セルに値が入力されるようにしました。このとき、コマンドボタンをクリックすると、フォーカスがユーザーフォームに残っています。これを、コマンドボタンをクリックした後、自動で対象のセルにフォーカスすることはできるでしょうか？何かよい方法はあるでしょうか？イメージは、１　コマンドボタンクリック　２セルに値がセットされる　３　マウスを手放す４　キーボードからセルの操作ができる状態（キーボードの矢印キーでセル移動ができる状態など）のような状態にしたいです。

質問日時: 2024/05/16 02:17 質問者: tsukita

ベストアンサー

3

0
エクセルについて

添付画像のsheet3のA.B.C.D.列の赤枠部とsheet1のA.G.H.I列の赤枠部が一致したらsheet3のG列の単価をsheet1のE列に転記することは可能でしょうか？マクロor関数どちらでもよいですが、希望は関数です。よろしくお願いいたします。

質問日時: 2024/05/14 23:26 質問者: Wrangleruk

ベストアンサー

2

0
ExcelのVBAコードについて教えてください。

シート名「昇降機【青紙】(裏面）」に下記のコードを設定しております。このコードは各セル("A6, A12, A13")のごれか一つに「■」と表示された場合他の2つのセルには何も表示されません。各セル("A6, A12, A13")をプルダウンで選択し「■」を表示されるとこのコードは上手く行くのですが、例えばセルA6に「=昇降機【青紙】チェックリスト!I27」の式で「■」を表示同じくセルA12に「=昇降機【青紙】チェックリスト!S27」の式で「■」を表示セルA13に「=昇降機【青紙】チェックリスト!O27」の式で「■」を表示されるように設定するとコードが上手く行かず、「=昇降機【青紙】チェックリスト!I27」「=昇降機【青紙】チェックリスト!S27」「=昇降機【青紙】チェックリスト!O27」の「■」が全てのセルに表示されてしまします。解決方法を教えてください。現状のコード Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range Set KeyCells = Range("A6, A12, A13") If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then If Target.Value = "■" Then Select Case Target.Address Case "$A$6" Range("A8").ClearContents Range("A12").ClearContents Range("A13").ClearContents Range("A16").ClearContents Range("A17").ClearContents Case "$A$12" Range("A6").ClearContents Range("A8").ClearContents Range("A13").ClearContents Range("A16").ClearContents Range("A17").ClearContents Case "$A$13" Range("A6").ClearContents Range("A8").ClearContents Range("A12").ClearContents Range("A16").ClearContents Range("A17").ClearContents End Select End If End If End Sub 以上です。宜しくお願い致します。

質問日時: 2024/05/14 14:38 質問者: エクセル小僧

ベストアンサー

1

0
VBAで大量のファイルをシート名ごとに転記やらいろいろしたい！

はじめまして、お世話になります。当方VBA初心者です。業務でCSVファイルを読み込み→別ブックへ貼り付け→基準値未満・以上のものを色付け（未満・以上になった回数を増やす）→・・・という作業を毎日手作業で行っております。 CSVファイルで出力されるのは、最大1536個です。数が多いのでVBAにて処理を行いたいと思い、ネットで探して組んだりしているのですがうまく動きません。どうかお知恵を貸していただけないでしょうか？やりたいこととしまして ①マクロ入りエクセルが入っているフォルダに保存されたCSVファイルをすべて読み込み ②右側、左側で転記するシートを変更したい（シート名がFPGA1○○日付時間、FPGA2○○日付時間で出力されます） ③1-1-001～6-2-128が入っていない場所は空白で転記されるようにしたい（出力された際に、1-1-001ではなく2-1-001から始まることもあり、挿入→下方向にシフトを行っております） ④転記する際に、各データの上にシート名にある日付時間を挿入したい ⑤転記されたデータから、基準値未満・以上のものをピックアップし、別シートへ転記（転記先の画像を添付いたします）　※棚は６までございます。 ⑥別シートの色付けと乗算　・色付けは不良回数が3～5回はオレンジ、6回以上で赤になるようにしたいです以上を組み込んでいただけると幸いでございます。説明がわかりにくいかもしれませんが、よろしくお願いいたします。

質問日時: 2024/05/13 12:28 質問者: maaaaatam

解決済

3

0
Vba 実数および実数タイプの変数について教えてください

いつもお世話になりますすみません、昔のプログラムの改良を頼まれたのですが実数表記と変数表記について、確認の為に教えてくださいまずは実数表記ですが通常、プログラムステートメントで A=１.0 とすると A=1# になると思いますが、A=1! と表記されていますが “!” はSingleタイプを表し、"#" はDoubleタイプを表すと考えて良いですか？次に実数タイプの変数についてですが dim S1# as double の時変数S1#と、"#"をつかない変数 S1 は同じ値を持つみたいですが、同じ変数になるのですか？これって昔のBasicの名残ですか？すみません、基本的なことですがよろしくお願いいたします

質問日時: 2024/05/10 11:07 質問者: 公共ごま

ベストアンサー

3

0
Excelのマクロについて教えてください。

下記のマクロを実行すると、メッセージが表示され、ダイアログが開き、不要ファイルをマウスで選択して、「OK」をクリックすると不要ファイルが削除されますが、マクロを実行すると画像のエラーメッセージが表示され、コードの「 Sh As SHFILEOPSTRUCT」部分の色が変色し、上手くマクロを実行できません。解決方法を教えてください。宜しくお願い致します。現行のマクロ ub 不要ファイル選択削除() Dim InitialPath As String InitialPath = ThisWorkbook.Path Dim rs As Integer rs = MsgBox("ファイルを削除します。", vbCritical + vbOKCancel, "削除の確認") If rs = vbOK Then Dim sPath As Variant With Application.FileDialog(msoFileDialogFilePicker) .Title = "削除するファイルを選択してください" .InitialFileName = InitialPath .AllowMultiSelect = True If .Show = True Then ReDim filePath(0) For Each sPath In .SelectedItems If filePath(0) <> "" Then ReDim Preserve filePath(UBound(filePath) + 1) End If filePath(UBound(filePath)) = sPath Next Call MoveDustbox(filePath) Else MsgBox "削除をキャンセルしました。", vbInformation .Execute End If End With End If End Sub Sub MoveDustbox(vPath As Variant) Dim sPath As Variant Dim Sh As SHFILEOPSTRUCT Dim ret As Long Sh.hwnd = Application.hwnd Sh.wFunc = &H3 Sh.fFlags = &H40 + &H10 If Not IsArray(vPath) Then Sh.pFrom = vPath ret = SHFileOperation(Sh) Else For Each sPath In vPath Sh.pFrom = sPath ret = SHFileOperation(Sh) Next End If End Sub 以上となります。宜しくお願い致します。

質問日時: 2024/05/09 09:12 質問者: エクセル小僧

ベストアンサー

1

0
エクセルVBAについて

tatsumaru77様以前投稿した内容で転記の追加をしたいのですが、内容は添付画像のようにA列に〇がある場合にW列の品名を別ファイルのC列に追加、AS列の個数をD列に追加です。追加していく条件は変更はありません。現在使用しているコードも記載しておきます。申し訳ありませんが、よろしくお願いいたします。 Private Sub case8() Dim fpath As String Dim wb As Workbook Dim ws1 As Worksheet Dim wb2 As Workbook Dim ws2 As Worksheet Dim maxrow1 As Long Dim row1 As Long Dim row2 As Long Set ws1 = ActiveSheet fpath = "N:\01生産管理課\01 個人ファイル\5000田中\図番転記.xlsm" Set wb2 = Nothing For Each wb In Workbooks If wb.Name = "図番転記.xlsm" Then Set wb2 = wb Exit For End If Next If wb2 Is Nothing Then Set wb2 = Workbooks.Open(fpath) End If Set ws2 = wb2.Worksheets(1) row2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row If ws2.Cells(row2, "A").Value <> "" Then row2 = row2 + 1 End If maxrow1 = 500 For row1 = 10 To maxrow1 If ws1.Cells(row1, "A").Value = "○" Then ws2.Cells(row2, "B").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _ ws1.Cells(row1, "O").Value & ws1.Cells(row1, "S").Value & ws1.Cells(row1, "U").Value ws2.Cells(row2, "A").Value = ws1.Cells(row1, "C").Value & ws1.Cells(row1, "E").Value & ws1.Cells(row1, "K").Value & _ ws1.Cells(row1, "O").Value & "10_00*" row2 = row2 + 1 End If Next End Sub

質問日時: 2024/05/06 12:26 質問者: Wrangleruk

ベストアンサー

1

0
VBA レジストリの値の読み方について教えてください

いつもお世話になります今、VBAを使ってExcelからDocuworksへの出力プログラムを作成しています今まではDocuWorksのフォルダーを指定して出力していましたが Versioniより場所が変わることがあり、フォルダを特定するためにレジストリを探していました（ほかに特定する場所があればよいのですが）そこで見つけたのが添付ファイルの場所でしたが上手く読めませんでした今まではVbaの「VB and VBA Program Settings」という場所のレジストリを使っていたので　sValue = GetSetting("MyChkBox301", "Main", "IsCheckBox315", "False") のように使っていたのですが今度はよそのSofyWareのレジストリを使うので下記のようにしてみましたが見つからないみたいで、Svalue＝False になってしまいます　sValue = GetSetting("HKEY_CURRENT_USER\Software\FUJIFILM\MPM3", "MPWS", "UserFolder", "False") 添付ファイルのUsefolderの値を読み込みたいのですが読み取り方が分かりましたら教えてください以上、宜しくお願い致します

質問日時: 2024/05/03 19:08 質問者: 公共ごま

ベストアンサー

1

0
VBAの計算で＠が出てしまう件

書式設定で文字列に設定してあるセルがあります。 C列やD列に"123456"や"56987"の値が入っています。こちらをVBAでSUMやVALUEを使って計算しているのですが、なぜか実行後セル内にSUM(VALUE(@C1:C2))と＠が入ってしまいます。原因、対処法を教えてください。以下がそのコードです。（VALUEを使用すると＠が入ってくる） SetSumRanges ws, emptyRow, lastRow, baseColumn, sumRange1, sumRange2, sumRange3, sumRange4, sumRangeFlg, "C", "D" Set sumRange1 = ws.Range(sumRange1Column & emptyRow + 1 & ":" & sumRange1Column & lastRow) ws.Range("A1").Formula = "=SUM(VALUE(" & sumRange1.Address & "))"

質問日時: 2024/05/02 17:21 質問者: aaaakkk

ベストアンサー

2

0

←前の結果
1
2
3
4
5
6
7
8
9
10
11
...
20
次の結果→

【プログラミング・Web制作】に関するカテゴリ

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう！

質問する（無料）

【Visual Basic（VBA）】に関するコラム/記事

弁護士が解説！あなたの声を行政に届ける「パブリックコメント」制度のすべて

社会に対する意見や不満、疑問。それを発信する場所は、SNSやブログ、そしてニュースサイトのコメント欄など多岐にわたる。教えて!gooでも「ヤフコメ民について」というタイトルのトピックがあり、この投稿の通り、...
弁護士が語る「合法と違法を分けるオンラインカジノのシンプルな線引き」

「お金を賭けたら違法です」ーーこう答えたのは富士見坂法律事務所の井上義之弁護士。オンラインカジノが違法となるかどうかの基準は、このように非常にシンプルである。しかし2025年にはいって、違法賭博事件が相次...
釣りと密漁の違いは？知らなかったでは済まされない？事前にできることは？

知らなかったでは済まされないのが法律の世界であるが、全てを知ってから何かをするには少々手間がかかるし、最悪始めることすらできずに終わってしまうこともあり得る。教えてgooでも「釣りと密漁の境目はどこです...
カスハラとクレームの違いは？カスハラの法的責任は？企業がとるべき対応は？

東京都が、客からの迷惑行為などを称した「カスタマーハラスメント」、いわゆる「カスハラ」の防止を目的とした条例を、全国で初めて成立させた。条例に罰則はなく、2025年4月1日から施行される。この動きは自治体...