Visual Basic

EXCELの差し込み印刷でPDFファイルを出力する方法 https://excel.kuuneruch.com/sasikomi-pdf-select/ 保存場所を同じフォルダに保存したいのですが、どうしたらよいでしょうか？ '⑥ひな形シートでPDFを作成する（作成PDFファイル名を指定する） Call CreatePdfFile("D:\100_PDF\" & .Range("A" & nowRow) & ".pdf")

在庫引当状況のシートを作成してます。 現状の在庫数から引当数を引いてくVBA方法を教えて下さい。 下記の方法をでは、最終行固定される為 最終行までとする方法・同じ内容のシートが 複数あるのでアクティブで処理したいです。 Range("A9").Value = Range("G7") - Range("F9") Range("A10").Value = Range("A9") - Range("F10") Range("A11").Value = Range("A10") - Range("F11") Range("A12").Value = Range("A11") - Range("F12") Range("A13").Value = Range("A12") - Range("F13") 〜 最終行まで よろしくお願いいたします

ガントチャートをエクセルで作成しているのですが、 それぞれのタスクの関係性がわかるよう、 関係元タスクの終点と、関係先タスクの始点を矢印で結びたいと思っています。 タスクリンクの始点終点に入力された数字を参照して、同じ数字の組み合わせを見つけ出し、 右側に関数で表示されている座標数値を参照させて矢印を引きたいと考えています。 ※座標数値はタスクの終了日を変更などで変動し、 　またガントチャート側の表示基準日を変更することで参照するべきセルが消失し、座標表示が空欄になることもあります。 例）タスクリンク３番の場合、 cell(10,31)からcell(12,38)へ cell(11,38)からcell(12,38)へ 　　2つの矢印が引かれることを想定しています。 以下のように座標を数字指定して矢印を挿入するマクロまでは作れたのですが、 共通するタスクリンク番号を抽出し、それぞれの座標数のあてはめ、矢印の作成を最大タスクリンク番号まで引くようなマクロにしたいです。 よろしくお願いいたします。 Sub タスクリンク() Dim endX As Single, endY As Single, startX As Single, startY As Single With Cells(10, 31) endX = .Left + .Width / 2 endY = .Top + .Height / 2 End With With Cells(12, 38) startX = .Left + .Width / 2 startY = .Top + .Height / 2 End With With ActiveSheet.Shapes.AddConnector(msoConnectorElbow, endX, endY, startX, startY).Line .EndArrowheadStyle = msoArrowheadTriangle .ForeColor.RGB = RGB(255, 0, 0) .DashStyle = msoLineRoundDot .Weight = 3 End With End Sub

エクセルVBAの初心者です。 下記①-⑲のようなコードを書きたいのですが、どなたかお分かりになる方がいましたら、 ご教示いただけますと幸いです。 ①　オートフィルターでシート[list]のA列に"●"がある特定の行だけを以下作業の対象にしたい ②　①で特定した行のE列セルの値を、シート[output]のB9セルにコピペする ③　①で特定した行のF列セルの値を、シート[output]のB12セルにコピペする ④　①で特定した行のG列セルの値を、シート[output]のB15セルにコピペする ⑤　①で特定した行のH列セルの値を、シート[output]のB18セルにコピペする ⑥　①で特定した行のI列セルの値を、シート[output]のB21セルにコピペする ⑦　①で特定した行のJ列セルの値を、シート[output]のB24セルにコピペする ⑧　①で特定した行のK列セルの値を、シート[output]のB27セルにコピペする ⑨　①で特定した行のL列セルの値を、シート[output]のB30セルにコピペする ⑩　①で特定した行のM列セルの値を、シート[output]のB33セルにコピペする ⑪　①で特定した行のN列セルの値を、シート[output]のB36セルにコピペする ⑫　①で特定した行のO列セルの値を、シート[output]のB39セルにコピペする ⑬　①で特定した行のP列セルの値を、シート[output]のB42セルにコピペする ⑭　①で特定した行のQ列セルの値を、シート[output]のB45セルにコピペする ⑮　①で特定した行のR列セルの値を、シート[output]のB48セルにコピペする ⑯　①で特定した行のS列セルの値を、シート[output]のB51セルにコピペする ⑰　①で特定した行のT列セルの値を、シート[output]のB54セルにコピペする ⑱　①で特定した行のU列セルの値を、シート[output]のB57セルにコピペする ⑲　シート[output]のB3：B59をテキストファイルを呼び出してコピペする ※このとき、上記②-⑱で記述したB9からB57のセルには改行が含まれる場合が 　あるため、テキストファイルへのペースト時に""が表示されてしまうが、 　もし可能であれば、この""が表示されないようにしたい。

以下の質問の回答者さんの頂戴し少し改変して、マクロでExcelの画像を一括挿入しています。 https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12139845762 貼り付けるセルが一列に並び画像を連続して下に貼り付けるだけであればこちらのマクロで大丈夫なのですが、 貼り付けるセルが2列3行になり、 1番目の写真　　2番目の写真 3番目の写真　　4番目の写真 5番目の写真　　6番目の写真 という風に貼り付けたいときにどうしたらよいのかがわかりません。 ActiveCell.Offset(21).Select の所で、セルの行が21下がって貼り付けられるということはわかるのですが… 使っているExcelファイルはいわゆるセルが方眼紙のようになっており、15行19列のセルを結合してそこに写真を貼り付けています。 1番目の写真を貼り付けた後に2列移動して貼り付けたいです。 ご教授いただければ幸いです。 使用しているマクロ↓ Sub ShpAdTest() Dim FNames As Variant, myShp As Shape Dim Fn As String, i As Long FNames = Application.GetOpenFilename( _ filefilter:="Image(*.jpg;*.gif;*.bmp;*.png),*.jpg;*.gif;*.bmp;*.png", _ Title:="図の挿入(複数選択可）", _ MultiSelect:=True) If Not IsArray(FNames) Then Exit Sub Call BubbleSort_Str(FNames, True, vbTextCompare) Application.ScreenUpdating = False For i = LBound(FNames) To UBound(FNames) PasteShp (FNames(i)) With ActiveSheet.Shapes(ActiveSheet.Shapes.Count) .LockAspectRatio = msoTrue .Placement = xlMove .DrawingObject.PrintObject = True .Height = ActiveCell.MergeArea.Height If .Width > ActiveCell.MergeArea.Width Then .Width = ActiveCell.MergeArea.Width End If .Top = ActiveCell.MergeArea.Top + (ActiveCell.MergeArea.Height - .Height) / 2 .Left = ActiveCell.MergeArea.Left + (ActiveCell.MergeArea.Width - .Width) / 2 End With ActiveCell.Offset(21).Select Next Call ShpCutPaste Application.ScreenUpdating = True End Sub Sub PasteShp(fname As Variant) Dim Shp As Shape Set Shp = ActiveSheet.Shapes.AddPicture( _ filename:=fname, _ linktofile:=False, savewithdocument:=True, _ Left:=Selection.Left, Top:=Selection.Top, _ Width:=0, Height:=0) Shp.ScaleHeight 1!, msoTrue Shp.ScaleWidth 1!, msoTrue Set Shp = Nothing End Sub Private Sub BubbleSort_Str( _ ByRef Source As Variant, _ Optional ByVal SortAsc As Boolean = True, _ Optional ByVal Compare As VbCompareMethod = vbTextCompare) If Not IsArray(Source) Then Exit Sub Dim i As Long, j As Long Dim vntTmp As Variant For i = LBound(Source) To UBound(Source) - 1 For j = LBound(Source) To LBound(Source) + UBound(Source) - i - 1 If StrComp(Source(IIf(SortAsc, j, j + 1)), _ Source(IIf(SortAsc, j + 1, j)), Compare) = 1 Then vntTmp = Source(j) Source(j) = Source(j + 1) Source(j + 1) = vntTmp End If Next j Next i End Sub ' ↓ 画像のリンク解除と画像ファイルサイズの低減 Private Sub ShpCutPaste() Dim Shp As Shape, Nm As String Dim x As Double, y As Double Application.ScreenUpdating = False For Each Shp In ActiveSheet.Shapes With Shp x = .Left y = .Top Nm = .Name .Cut End With ActiveSheet.PasteSpecial Format:="図 (JPEG)", _ Link:=False, DisplayAsIcon:=False With Selection .Left = x .Top = y .Name = Nm End With Application.CutCopyMode = False Next Application.ScreenUpdating = True End Sub

C１から下へずらーっと、キーワードや文章が記入されています。 このセル内のキーワードをGoogle検索して、『検索結果が○件以下だったら隣に○』 という風に分けていきたいです。 こういう作業は、マクロでできるでしょうか？ どのような記述でできますか？ EXCEL2016です。 よろしくお願いいたします。

よろしくお願いします。 エクセルで自動登録で自動化をしていますが、これだと限界があり今回こちらに書き込みさせていただきました。 流れとしては、マクロスタートでダイアログがでて（可能なら奥底に格納されるブックなのでそのフォルダの一個前辺りの階層指定されて）そこで指定した毎日新しく作られるブック内の指定したシートの指定したセルにあるデータをコピー（ブックは開かないで読み込み）してテンプレートととしている空のブックを開き（開いたまま）指定したシートの指定したセルにペーストするマクロを作りたいです。 （指定したシートと指定したセルの名前は常に同じです） 自動記録で指定したブックを開いて読み込む事は出来ましたが、毎回別のブックなのでそれでは事足りないのです。 ネットで探しましたが… ・ダイアログでファイルを開くマクロは見つけましたが、開いた後内部のデータを読み込むなどマクロは見つかりませんでした。 つながるところがわかりません。 ・（存在するブックの場所指定で）ブックを開かないでその中のデータを読み込むマクロは見つけましたが、ダイアログで選ぶけど開かないでと言う事が出来るマクロは見つけられませんでした これらは元々出来ないのでしょうか？ 可能で有ればご教示下ださると助かります。 よろしくお願いします。

Htaの入力フォームで入力したデータをリセットするボタンを作りたいです。 詳しい方教えてくれると嬉しいです。 ボタンの設置方法 リセット可能な範囲の指定の仕方 よろしくお願いします

ExcelVBAマクロについて確認させてください。 プログラム高速化のために２番目のワークシート貼り付け先範囲を配列化しました。 １番目のワークシートの文字をtrim関数によって前後の空白を除去したうえで２番目のワークシートに貼り付けようとしていますが、空白が除去できていない状況です。 何か原因なのでしょうかm(__)m Sub test() Dim x As Long Dim y As Long Dim x2 As Long Dim y2 As Long Dim a As String Dim Table As Variant '配列化のため '最大列取得 x = Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column '最大行取得 y = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row Table = Worksheets(2).Range(Worksheets(2).Cells(1, 1), Worksheets(2).Cells(y, x)) '貼り付け先範囲を配列化 For x2 = 1 To x '最大列 For y2 = 1 To y '最大行 a = Worksheets(1).Cells(y2, x2).Value Table(y2, x2) = Trim(a) 'ワークシート１の値から前後空白を取り除いてワークシート２に貼り付け Next Next End Sub

A.exe ⇒ B.dllの関数 ⇒ C.dllの関数 の順で関数をコールするのですが、C.dllの関数をコールする際に DllNotFoundExceptionが出てしまいます（「'C.dll' を読み込めませんでした。」） また、上記エラーはPCによって発生しない場合もあるのですが、 原因として何が考えられるでしょうか。 動作確認したPCのフォルダ構成は同じで下記のようになっており、 EXEとDLLはすべて同じフォルダ内に存在しているため原因がよくわかりません。 BIN ├A.exe VB.net ├B.dll VB.net └C.dll C言語

宜しくお願いします。 A1～A10に数値、B1～B10に乱数を発生させて（RAND関数）、C1～C10にその順位を出す、その順位をG1～G10にコピー、F列に1行挿入、　 これを10回繰り返す。 マクロのボタンを１回押せば、これが実行される。これを５回したいときはボタンを５回押せばいい？これを実行できるコードがあるのでしょうか、わかりません。お教えください。

ネットから下記のコードを見つけたのですが、１つのシートに複数のオートシェイプの色塗りを変更する方法を教えてください。 例えばセル"A1"には数値の1と"A2"には数値2を入力したら、 オートシェイプAにはセル"A1"に対応した色塗り『赤色』を オートシェイプBにはセル"A2"に対応した色塗り『黄色』といった感じです。 下記のコードをいくつも繋げれば、複数のオートシェイプの色塗りが出来ると思ったのですが、コードを繋げる方法がわかりません。その他に何か良い方法がありましたら教えてください。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) <> "A1" Then Exit Sub With ActiveSheet.Shapes("ABC").Fill.ForeColor Select Case Target.Value Case Is = "赤" .SchemeColor = 2 Case Is = "黄" .SchemeColor = 5 Case Is = "緑" .SchemeColor = 3 Case Is = "青" .SchemeColor = 4 Case Else .SchemeColor = 1 End Select End With End Sub

ExcelVBAマクロについて確認させてください。 関数の入ったWorksheets(1)をWorksheets(2)に関数ごとコピーさせてさらにTrim関数で文字列前後の空白を除去するコードを作成しましたが、Worksheets(2)では関数が消えてしまい、 値のみコピーになってしまいます。 関数ごとコピーしてさらに文字列前後の空白を除去するコードがあればお教えくださいm(__)m

vbdll.dll: int * __stdcall arr() { int a[] = {1,2,3}; return a; } vba: Declare Function arr Lib "C:\temp\vbdll.dll" () As Long() Sub test() Dim ccc() As Long ccc = arr Debug.Print ccc(0) End Sub インデックスが有効範囲にありませんになります 配列をDLLの戻り値としてVBAで受け取る書き方を教えてください？ 何卒、ご教授お願いします。

Excel の1つのファイル内の偶数番シートのA列が空白であるセルを行ごと削除したいのですが、下のコードではうまく動かないです。 シート番号はSheet(2)から(90)までです。 Sub 空白行削除() Dim i For i = 2 To 90 Step 2 Worksheets(i).Activate Columns("A:A").Select Selection.SpecialCells(xlCellTypeBlanks).Select Selection.EntireRow.Delete Next i End Sub

コンボボックスにclickイベントを書いたのち（この段階ではprivate） このコントロールをユーザコントロールにしました。 フォーム上に上記のユーザコントロールを配置したところ クリックイベントが発生しません クリックイベントを発生させるには 何か特殊な記述が必要ですか？（例えばオーバライドとか） どうすればクリックイベントを発生させられますか

accessへのインポートについて質問です。 VBAをつかってボタンを押すとファイル選択ダイアログが開き選択すると既存のテーブルへインポートするものを作成したいと考えています。 検索して出てきたものを加工して使ってみているのですが理想形になりません。 現状いまのままでも使えてはいるのですがより効率的にしたいと思っています。 具体的には以下の２点を修正したいと考えています。 ・元データは本来はＣＳＶのためＣＳＶのまま取り込みたい 範囲指定の際にExcelの関数を使って求めているためそれをCSV 現状はCSVを一度Excelに修正しています。 ・Ａ２のセルに日付（ユーザー定義ｙｙｙｙ年ｍｍ月ｄｄ日）が入っているためそれをUPDATEだデータに追加したい 現状は入力を求められるためそこに入力すると反映されます。 また、反映時はｙｙｙｙ/ｍｍ/ｄｄという表記で表示をしたいです。 一応Gとしてデータの取得はしていると思うのですがうまくいきません。 取り込むデータをCSVとExcelにしているのはもう一つ取込用のボタンがありそちらの取込はCSVだからです。 （CSVだけで取り込めるようになったらExcelは消します） 独学でネットにあるものをつまんでいる状況のため専門用語などが分からず説明が足りていないところなどありましたらご質問下さい。 宜しくお願い致します。 Private Sub コマンド1_Click() Dim msg As String msg = getFilePicker If msg = "" Then Exit Sub Dim objFileSys As Object Dim fileName As String Dim FN As Variant 'ファイルシステムを扱うオブジェクトを作成 Set objFileSys = CreateObject("Scripting.FileSystemObject") '拡張子無しのファイル名を取得 fileName = objFileSys.GetBaseName(msg) FN = objFileSys.GetAbsolutePathName(msg) Dim b As Long Dim r As Long Dim G As Date With CreateObject("Excel.Application") With .Workbooks.Open(FN) 'G = CDate(.Sheets(fileName).Range("A2").Value) b = .Sheets(fileName).Cells(1, 1).End(-4121).row .Close False End With End With DoCmd.TransferSpreadsheet acImport, , "T_G", msg, True, "B7:I" & b Dim sql As String DoCmd.SetWarnings WarningsOn:=False sql = "UPDATE T_G SET 入金日 = G WHERE Nz(入金日)=''" DoCmd.RunSQL sql DoCmd.SetWarnings WarningsOn:=True Set objFileSys = Nothing On Error GoTo err_sample err_sample: Select Case Err.Number Case 3011 MsgBox "ファイルが見つかりません。処理を終了します。" Case Else MsgBox Err.Number & ":" & Err.Description End Select End Sub Function getFilePicker(Optional dTitle As String = "ファイル選択") Const msoFileDialogFilePicker As Integer = 3 Dim fDlg As Object Set fDlg = Application.FileDialog(msoFileDialogFilePicker) fDlg.Title = dTitle fDlg.InitialFileName = "ダウンロード" '任意のフォルダパスを入れてください fDlg.AllowMultiSelect = False fDlg.Filters.Clear fDlg.Filters.Add "Excel Files(*.xls)", "*.xlsx;*.xls" fDlg.Filters.Add "Text Files(*.csv;*.txt)", "*.csv;*.txt" fDlg.FilterIndex = 1 If fDlg.Show Then getFilePicker = fDlg.SelectedItems(1) Else getFilePicker = "" End Function

Outlookでメールの本文をWordに貼り付けるマクロって作れませんか

VBA初心者です。 コードはネットで調べて組み合わせて作っております。 今回は、組み合わせたコードで処理が終わってもフォルダ内のファイル数の数だけ処理を繰返したいです。 事前に作っているコードは、 ①データ読み取りをしたいExcelを開く、別ブックを開いて該当のセルに入力。セル自体に数式が入っているので各シートに反映されます。 ②inputboxで各シートの該当セルに表示させたい文字を入力。 ③3、4枚目のシートを選択。 ④名前をつけて保存する。 という作業のコードになっています。 ①～④までを行った後に、データ数に応じて処理を繰返し行いたいです。 下記のコードにしたところ、Nextに対応するForがありません。とエラーが出ます。End Ifは追加しているのにエラーが起きるのはなぜでしょうか？ ---下記　コード--- Sub マスターデータ取込03() '選択したファイルを取り込み、別のファイルに貼り付ける。 For Each f In fso.GetFolder(folderpath).Files If fso.GetExtensionName Like "xls?" Then Set wb = Workbooks.Open(f) Dim RC As Integer Dim OpenFileName, FileName, Path, SetFile As String Dim wbMoto, wbSaki As Workbook Set wbMoto = ActiveWorkbook 'マスターデータ取り込み元をセット Application.DisplayAlerts = False RC = MsgBox("マスターデータ取込みますか？", vbYesNo + vbQuestion, "確認") If RC = vbYes Then OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?") 'ダイアログボックスを表示して、マスターデータファイルを指定します。 If OpenFileName <> "False" Then SetFile = OpenFileName Else MsgBox "キャンセルされました" Exit Sub 'マスターデータの取り込みをキャンセル End If Workbooks.Open FileName:=SetFile, ReadOnly:=True, UpdateLinks:=0 'ダイアログボックスで指定したマスターデータファイルを開きます。 Set wbSaki = Workbooks.Open(Path & SetFile) 'ワークブック間のシート「項目」をコピーします。 wbSaki.Worksheets("内訳書").Range("D:O").Copy wbMoto.Worksheets("見積入力").Range("U7").PasteSpecial xlPasteValues Application.CutCopyMode = False 'コピー切り取りを解除 wbSaki.Close False 'マスターデータ取り込み先のファイルを閉じる Else MsgBox "処理を中断します" End If Application.DisplayAlerts = True Dim ans As String ans = InputBox("見積書・請求書No", "", "") If ans <> "" Then wbMoto.Worksheets("見積").Range("I3").Value = ans Worksheets("見積").Range("I3").Value = "ＶＨＭ-" & ans End If Application.DisplayAlerts = True ans = InputBox("見積書発行日", "", "") If ans <> "" Then wbMoto.Worksheets("見積").Range("F11").Value = ans End If ans = InputBox("完工日", "", "") If ans <> "" Then wbMoto.Worksheets("請求").Range("F11").Value = ans End If ans = InputBox("請求書発行日", "", "") If ans <> "" Then wbMoto.Worksheets("請求").Range("F12").Value = ans End If Worksheets(Array(2, 3)).Select ' 1 番目と 2 番目のシートを選択 Dim xFile xFile = Application.GetSaveAsFilename( _ FileFilter:="Excelファイル, *.xlsm") If TypeName(xFile) <> "Boolean" Then ActiveWorkbook.SaveAs FileName:=xFile End If Next End Sub

　PICとVisual basicで通信を行いたいです。 　全体的な仕組みとしてはPICでモーターなどを動かし、VBで現在どのようになっているのかパソコンの画面に映す…といった感じです。 　なので「PIC側のボタンを押せばVBの画面も一緒に変化する」、もしくは「VBでボタンをクリックするとPICのモーターも一緒に動く」といった信号を送る方法が知りたいです。 　プログラミングの勉強中なので完璧なプログラムを教えるのではなく、「○○って言葉で検索して」といったようなヒントを与える感じで答えていただけると幸いです。 　それと先日ZigBeeを使えるようになったので、それも使えたらなと考えています。