Visual Basic

に実装する際の2回目の処理について助けてください。 Sub Action1or2() Static ChkNext As Boolean If ChkNext = False Then ChkNext = True MsgBox "１回目の押下です。" ' ' Macro1 Macro Range("L9").Select Selection.Copy Sheets("様式２(管理表)").Select Range("C10").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("様式1-1(作業用) ").Select Range("C9:K9").Select Application.CutCopyMode = False Selection.Copy Sheets("様式3(チェック表)").Select Range("B9").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("様式1-1(作業用) ").Select Range("L9").Select Application.CutCopyMode = False Selection.Copy Sheets("様式4(22F倉庫用) ").Select Range("D9").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("様式1-1(作業用) ").Select Else ChkNext = False Call Action2 End If End Sub Sub Action2() MsgBox "２回目の押下です。" 'ここに２回目の実行コードを記述 End Sub 2回目に実行ボタンをクリックした際にSheets("様式1-1(作業用) ")のアクティブセルと("Sheets様式２(管理表"))＆"様式3(チェック表)")&"様式4(22F倉庫用) "）のA列にアクティブセルの値とイコールの値がある場合、アクティブセルの2行下の行を選択してコピーを行い、各シートの対象セルの行へ貼り付けをする場合どのような記述をすれば良いかご教示ください。 よろしくお願いします。

毎日使用しているシステムにてAccess2003 VBAでの通信で 数日前から突然エラーが出て通信できなくなりました。 下記のSENDの部分で エラー -2416697208 (800c0008)になります。 　 With CreateObject("MSXML2.ServerXMLHTTP.6.0") .Open "POST", strUrl, False .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded" .Send (strParam) strResult = .ResponseText End With 端末の環境はWindows7 ブラウザはIE11 Windows Updateやセキュリティーなど 一切変更などしていないのですが 急にエラーが出る部分がどうしても分からず 仕事に支障が出て困っております。 他のノートパソコンへシステムのこの機能だけを入れると 正常に動いたりします。 ノートパソコンも同じくWindows7 ブラウザはIE11です。 解決方法があればお教え願いたいです。 よろしくお願いいたします。

下記のコードを、条件付き書式で変化した文字色によって作動させたいのですが、変化した赤字を認識せずに作動しません。 どこを修正したら良いでしょうか？ Private Sub CommandButton1_Click() Dim cell As Range For Each cell In Range("L28,P28,T28,X28,AB28,AF28,AJ28,AN28,AV30,BC30,BG30,BK30,BO30,BS30,CE28") If cell.Font.ColorIndex = 3 Then ' 赤文字の場合 ユーザフォーム1.Show ' ユーザフォーム1を表示する Exit Sub End If Next cell Range("CI28").Value = "ok" ' セル"CI28"に"ok"を入力する End Sub

ActiveSheet.Hyperlinks.Add Anchor:= と記載して続きを書こうとすると、Anchor:=の :=部分でコンパイルエラー「修正候補：式」と表示されます。 理由が分かれば教えていただきたいです。

VBA初心者です。お知恵を貸してください。 UserForm上にある全てのコンボボックス(１つを除く)に同じchangeイベントを適応させたいです。 【動き】 1.UserForm起動 2.フォーム上のSheetComboBoxからシートを選択 3.選択したシートを参照し、フォーム上にシートにある行数分ComboBoxi(変数)_1〜3、TextBoxi(変数)を作成。ComboBoxにシートの値を参照した「文字列 数値」をセット。TextBoxは空欄。 4.ComboBoxi_1〜3が変更されるごとに、TextBoxiにComboBoxの内容の数値部分を計上する。 5.登録ボタンをクリックしてComboBoxi_1〜3の内容をシートの特定列に転記。 3までは作成することができましたが、4で行き詰まってしまいました。 コンボボックスのコントロール名は動的なので、どのようにchangeイベントを書けばいいのか、また、コンボボックスの量が多い(1行3つ*行数分)ので、すべてに対して書かなければならないのか…ということです。 何か一括でchangeできるような方法をご存知の方は教えていただけないでしょうか。どうぞよろしくお願いいたします。

Q列に同じ行のA列に文字が入ると、タイムスタンプを挿入して、時間の経過と共に、720時間かけて白から赤にグラデーション変化する。 上記のVBAを行いたいのですが、オーバーフローエラーが発生します。どの様に修正すれば良いでしょうか？ Private Sub Worksheet_Change(ByVal Target As Range) Dim currentDate As Date Dim startTime As Date Dim endTime As Date If Target.Column <> 1 Or Target.Cells.Count > 1 Then Exit Sub If Target.Offset(0, 15).Value = "" And Target.Value <> "" Then startTime = Now() Target.Offset(0, 15).Value = startTime ElseIf Target.Offset(0, 15).Value <> "" And Target.Value = "" Then endTime = Now() Target.Offset(0, 15).Value = "" End If currentDate = Now() If Target.Offset(0, 15).Value <> "" Then Target.Offset(0, 16).Interior.Color = GradientColor(Target.Offset(0, 15).Value, currentDate, startTime, 720) Else Target.Offset(0, 16).Interior.Color = RGB(255, 255, 255) End If End Sub Function GradientColor(ByVal timeStart As Date, ByVal timeEnd As Date, ByVal startTime As Date, ByVal duration As Integer) As Long Dim secondsElapsed As Long Dim fractionTimeElapsed As Double secondsElapsed = DateDiff("s", startTime, timeEnd) ➡︎ fractionTimeElapsed = secondsElapsed / (duration * 3600) fractionTimeElapsed = IIf(fractionTimeElapsed > 1, 1, fractionTimeElapsed) GradientColor = RGB(255 * (1 - fractionTimeElapsed), 255 * fractionTimeElapsed, 255 * fractionTimeElapsed) End Function

ダブルクリックでフォームを開くようにしてます。下記のままでしたらテキストボックスに何行でも入力できてしまい、転記先のセルは4行までしか表示ができません。テキストボックスに4行以上入力しコマンドボタンをクリックしたときにメッセージが出てセル値を取得したときに戻ればいいと考えています。説明が不十分ですがよろしくお願いします。 Private Sub UserForm_Initialize() TxtA.MultiLine = True TxtA.EnterKeyBehavior = True GYOU = ActiveCell.Row TxtA.Value = Range("c" & GYOU).Value End Sub Private Sub CommandButton1_Click() GYOU = ActiveCell.Row Range("c" & GYOU).Value = UserForm1.TxtA.Value Unload Me End Sub

（※）の行にエラーがでているのですが、何を指摘されているのか、どう直せば良いのかが分かりません。下記の情報だけで何かわかりますか？エラー名はインデックスが有効範囲にありませんです。 '******************************************************************************* '機能名　　：指定文字を含むシートを検索し、指定文字を含んだシート名を返す '引数　　　：指定文字（String型） '戻り値　　：指定文字を含んだシート名を返す（String型） '備考　　　：指定文字を含んだシート名が存在しない場合は"NotFound"が返される '******************************************************************************* Public Function gFnc_strSelectSheet(ByVal strTargetSheetName As String) As String Dim i As Integer, intChkFlg As Integer Dim strResult As String intChkFlg = 0 For i = 1 To Sheets.Count （※）If InStr(Worksheets(i).Name, strTargetSheetName) > 0 Then strResult = Worksheets(i).Name intChkFlg = 1 End If Next If intChkFlg = 0 Then strResult = gcnstrNotFound gFnc_strSelectSheet = strResult End Function

VBSについて質問です。プログラミング初心者です。 既定フォルダ内のファイルを選択したフォルダ内にコピーするプログラムを組みたく、 色々調べながら作成してみましたが、うまくいきません。 症状として、選択したフォルダではなく、 プログラムを保存しているフォルダにコピーされてしまします。 選択したフォルダに保存するためには、どのようにすればいいでしょうか？ また、下記コードがうまくいかない理由も解説もしてくださると大変助かります。 C:\strFrom　←既定のコピー元フォルダ C:\strTo　　←プログラム実行時に選択するコピー先フォルダ C:\VBS　　　←プログラムを保存しているフォルダ　※ここにフォルダ名「strTo」で「strFrom」内のファイルが保存される Set objFS = CreateObject("Scripting.FileSystemObject") 'ファイルシステムオブジェクト作成 strFrom = "C:\strFrom" 'コピーするフォルダのパス Set shla = WScript.CreateObject("Shell.Application") 'Shellの呼び出し Set strTo = shla.BrowseForFolder(0, "フォルダを選択して下さい", &H1) 'パス取得 WScript.echo strTo.Items.Item.Path '取得パス確認 objFS.CopyFolder strFrom, strTo 'ファイルコピー

Visualbasic 2013 を利用して Windows Formアプリケーションを開発しております。 Form上にPanelを配置し、その中にDatagridViewを配置しております。 ※Anchorを「Top, Left, Right」と指定しております。 このような場合、フォームデザイナで他のコントロールのデザインを編集してリビルドするとDatagridViewのサイズが変化してしまいフォームのサイズよりも大きくなる事象が発生しております。 大変お手数お掛けいたしますが、何か原因/対策などわかる方がいらっしゃいましたらご教授頂けますと幸いです。

シート上のCommandButton1を押すと、a2:d3までのセル内に赤字があれば、ユーザーフォーム1が起動する、セル内の赤字が緑になる　 上記のようなマクロは可能でしょうか？ マクロ初心者ですので、サンプルコードがあれば助かります。

データベースよりデータ抽出しDatatableにセットしデータグリッドビューのDatasourceにセットしてデータ表示しております。 以下のような制御を実施するとデータが表示されない事象が致しました。 大変お手数お掛けいたしますが何か解決策が分かる方がいらっしゃいましたらご教授頂けないでしょうか。 (1)データベースよりデータ抽出しDatatable(dt1)にセット (2)データグリッドビューのDatasourceにセット→データが表示される (3) (1)のデータテーブルにDatatable.Select(抽出条件) (4)別のデータテーブル(dt2)に(3)の結果をCopyToDataTable (5)データグリッドビューのDatasourceにセット→何も表示されない

お願いします。いま以下の作業をかりに1000回繰り返し、なおかつ その進捗状況を可視化（数値で）する一番簡単な記述は どのように書けばいいのでしょうか。実行の順番も併せて VBA上級者の方、よろしくお願いいたします。 Sub 移動() ' ' 移動 Macro Range("D6:D15").Select Selection.Copy Range("H6").Select ActiveSheet.Paste Columns("G:G").Select Application.CutCopyMode = False Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("C2").Select End Sub

メール本文にファイルの保存場所を記載し、クリックでファイルが開くようにしたいのですが、どうすればいいでしょうか。 幾つか試しましたがうまくいきませんでした。 Cells(5, "AK")=C:\Users\taro\Documents\エクセル.xlsxとした時 Sub メール() 'Outlookの定義 Set myOutLook = CreateObject("outlook.application") Set Omail = myOutLook.CreateItem(olMailItem) 'メール作成 With myitem Omail.BodyFormat = 2 ①.HTMLBody = .HTMLBody & "<a href=file:\\\""" & Cells(5, "AK") & """>意見書1</a>" & "<br>" →\\\以降の番地が表示されない ② .HTMLBody = .HTMLBody & "<a href=""" & Cells(5, "AK") & """>意見書2</a>" & "<br>" →<C:\Users\taro\Documents\エクセル.xlsx>と表示されるがリンクされない。 ローカルドライブとサーバーでは書き方が違うようです。 自分が最終的にしたいのはサーバーに保存しているファイルをクリックで開くことです。 正しい書き方をご教示ください。よろしくお願いいたします。

VisualBasic2015で変数の宣言の仕方を教えてください。

記のようなコードでエクセルVBAでOutlookメールを作成する際、「期限：10月30日」の部分だけを赤にする方法を教えてください。 <font color = ""#ff0000"">" & "期限：10月30日" & "</font>" このようなコードを使うようなのですが、下記にどのように変更すれば動くのか教えてください。 Sub メール() 'Outlookの定義 Set myOutLook = CreateObject("outlook.application") Set Omail = myOutLook.CreateItem(olMailItem) 'メール作成 Omail.BodyFormat = 2 Omail.Subject = "意見記入のお願い" 'subject Omail.Body = Omail.Body & "いつもお世話になっております。" & vbCrLf Omail.Body = Omail.Body & "下記の申請が提出されました。" & vbCrLf Omail.Body = Omail.Body & "期限：10月30日" Omail.Display End Sub

VB.NETを実行するにはどうしたらいいですか？2022です。

VB.NETってフリーでダウンロードできるんですか？

おはようございます。 すいませんが行き詰りましたので 皆様にご教授お願い致します。 やりたいこと sheet１シート内の情報 B2:CB2セルまで日付が入っています。 （B2には3/1、C2には3/2と連続して日付が入っています。） B3:CB3セルまで空白行が有ります。 B4:CB4セルまでどれかに”平日”という文字が有ります。 sheet2シート内の情報 E4:AI4セルに数字 （E4は1、F4は2・・・AI4は31と順番に数字が入っています。） E5:AI5セルには、空白行が有ります。 この中で もし、sheet1のB2:CB2セルまでの間で3/から始まる文字列が有り B3:CB3セルまでの間で""空白が有り B4:CB4セルまでの間で"平日"という文字が有れば （すべての条件が合えば） E4:AI4の数字に合うセル 例：3/1ならE4セルが１なのでE５セルに”勤務という文字” 　　3/5ならI4セルが５なのでI５セルに”勤務という文字” 　　3/31ならAI4セルが３１なのでAI５セルに”勤務という文字” を入れていきたいのですが 下記コードでは sheet１のB2セルに3/1があったときのみには sheet2のE5セルに”勤務”という文字が入るのですが 実現したいのは 例えば、sheet１のD2セルに3/1から始まっても E5セルに”勤務”と反映させたいです。 このコードでは、D2セルから3/1、E2セルに3/2という形だと sheet2のG5セルとH5セルに”勤務”と入ってしまいます。 変数ｋの値をいちいち変更したら 希望通りに動くのですが 出来れば、変数kの値を変更させないように うまくsheet1のB2:CB2のどれかに日付が入っても sheet2のE5:AI5の位置に条件が合えば”勤務”っていう文字を 入れたいです。 何回やってもわからなかったため すいませんがコード記載していただけますと 大変助かります。 回答よろしくお願いします。 Sub test() Dim ws1 As Worksheet Set ws1 = Worksheets("Sheet1") Dim ws2 As Worksheet Set ws2 = Worksheets("Sheet2") For k = 2 To 80 If ws1.Cells(2, k).Value Like "3/*" Then 'もし、(sheet1)シートのB2：CB2セルまでの間で3/から始まる文字列が有れば If ws1.Cells(3, k).Value = "" Then 'もし、B3:CB3セルまでの間で""空白が有れば If ws1.Cells(4, k).Value = "平日" Then 'もし、B4:CB4セルまでの間で"平日"という文字が有れば ws2.Cells(5, k + 3).Value = "勤務" ' End If End If End If Next k End Sub

Sub Dim G_name As String G_name = Range(”I15”) 'l15は、aaa.xlsx ～略～ Workbooks(G_name).SaveAs filename:=(アドレス略) End Sub これだと保存され、 Sub Dim G_name As String、file_name As String G_name = Range(”I15”) 'l15は、○○○.xlsx file_name = Dir(○○○) Do While file_name <> ”” ～略～ Workbooks(G_name).SaveAs filename:=(アドレス略) Loop End Sub これだとSaveAsの所でエラーになります。 エラー解消方法、何かあるでしょうか