Visual Basic
- VBA MSXML2.XMLHTTPで通信エラー
毎日使用しているシステムにて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です。 解決方法があればお教え願いたいです。 よろしくお願いいたします。
- 締切済み
- Visual Basic
- junshin2300
- 回答数3
- VBAで条件付き書式の文字色
下記のコードを、条件付き書式で変化した文字色によって作動させたいのですが、変化した赤字を認識せずに作動しません。 どこを修正したら良いでしょうか? 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
- ベストアンサー
- Visual Basic
- kubotaman
- 回答数3
- Hyperlinks.Add について
ActiveSheet.Hyperlinks.Add Anchor:= と記載して続きを書こうとすると、Anchor:=の :=部分でコンパイルエラー「修正候補:式」と表示されます。 理由が分かれば教えていただきたいです。
- ベストアンサー
- Visual Basic
- y_ykr
- 回答数3
- 全てのコンボボックスに同じchangeイベント
VBA初心者です。お知恵を貸してください。 UserForm上にある全てのコンボボックス(1つを除く)に同じ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できるような方法をご存知の方は教えていただけないでしょうか。どうぞよろしくお願いいたします。
- 締切済み
- Visual Basic
- ok-scho-ok
- 回答数4
- タイムスタンプを挿入して、時間の経過に合わせて色
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
- ベストアンサー
- Visual Basic
- kubotaman
- 回答数4
- ユーザーフォームテキストボックスの文字制限
ダブルクリックでフォームを開くようにしてます。下記のままでしたらテキストボックスに何行でも入力できてしまい、転記先のセルは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
- ベストアンサー
- Visual Basic
- 1963momomo
- 回答数5
- VBA 修正箇所について
(※)の行にエラーがでているのですが、何を指摘されているのか、どう直せば良いのかが分かりません。下記の情報だけで何かわかりますか?エラー名はインデックスが有効範囲にありませんです。 '******************************************************************************* '機能名 :指定文字を含むシートを検索し、指定文字を含んだシート名を返す '引数 :指定文字(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
- ベストアンサー
- Visual Basic
- maron915
- 回答数5
- VBSについて
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 'ファイルコピー
- ベストアンサー
- Visual Basic
- Mimlck
- 回答数1
- Visualbasic DatagridView
Visualbasic 2013 を利用して Windows Formアプリケーションを開発しております。 Form上にPanelを配置し、その中にDatagridViewを配置しております。 ※Anchorを「Top, Left, Right」と指定しております。 このような場合、フォームデザイナで他のコントロールのデザインを編集してリビルドするとDatagridViewのサイズが変化してしまいフォームのサイズよりも大きくなる事象が発生しております。 大変お手数お掛けいたしますが、何か原因/対策などわかる方がいらっしゃいましたらご教授頂けますと幸いです。
- 締切済み
- Visual Basic
- 19820202
- 回答数1
- マクロ
シート上のCommandButton1を押すと、a2:d3までのセル内に赤字があれば、ユーザーフォーム1が起動する、セル内の赤字が緑になる 上記のようなマクロは可能でしょうか? マクロ初心者ですので、サンプルコードがあれば助かります。
- ベストアンサー
- Visual Basic
- kubotaman
- 回答数5
- Datagridviewで例外
データベースよりデータ抽出しDatatableにセットしデータグリッドビューのDatasourceにセットしてデータ表示しております。 以下のような制御を実施するとデータが表示されない事象が致しました。 大変お手数お掛けいたしますが何か解決策が分かる方がいらっしゃいましたらご教授頂けないでしょうか。 (1)データベースよりデータ抽出しDatatable(dt1)にセット (2)データグリッドビューのDatasourceにセット→データが表示される (3) (1)のデータテーブルにDatatable.Select(抽出条件) (4)別のデータテーブル(dt2)に(3)の結果をCopyToDataTable (5)データグリッドビューのDatasourceにセット→何も表示されない
- 締切済み
- Visual Basic
- 19820202
- 回答数2
- VBA進捗状況を可視化(数値)で
お願いします。いま以下の作業をかりに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
- ベストアンサー
- Visual Basic
- krikrikirkri
- 回答数4
- エクセルVBAでOutlookにリンク設定
メール本文にファイルの保存場所を記載し、クリックでファイルが開くようにしたいのですが、どうすればいいでしょうか。 幾つか試しましたがうまくいきませんでした。 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>と表示されるがリンクされない。 ローカルドライブとサーバーでは書き方が違うようです。 自分が最終的にしたいのはサーバーに保存しているファイルをクリックで開くことです。 正しい書き方をご教示ください。よろしくお願いいたします。
- ベストアンサー
- Visual Basic
- ticktak
- 回答数2
- VBAでOutlookの文面の一部を赤にする方法
記のようなコードでエクセル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
- ベストアンサー
- Visual Basic
- ticktak
- 回答数2
- VBA指定した日付に条件が合えば文字を入れたい
おはようございます。 すいませんが行き詰りましたので 皆様にご教授お願い致します。 やりたいこと sheet1シート内の情報 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セルが1なのでE5セルに”勤務という文字” 3/5ならI4セルが5なのでI5セルに”勤務という文字” 3/31ならAI4セルが31なのでAI5セルに”勤務という文字” を入れていきたいのですが 下記コードでは sheet1のB2セルに3/1があったときのみには sheet2のE5セルに”勤務”という文字が入るのですが 実現したいのは 例えば、sheet1のD2セルに3/1から始まっても E5セルに”勤務”と反映させたいです。 このコードでは、D2セルから3/1、E2セルに3/2という形だと sheet2のG5セルとH5セルに”勤務”と入ってしまいます。 変数kの値をいちいち変更したら 希望通りに動くのですが 出来れば、変数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
- ベストアンサー
- Visual Basic
- TaikooniQ1
- 回答数3
- SaveAsが Do~Loopでうまくいかない
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の所でエラーになります。 エラー解消方法、何かあるでしょうか
- ベストアンサー
- Visual Basic
- satoimogozen
- 回答数4
- VBAの連番の振り方について
セルC1からC10まで罫線の表があり、inputboxで入力された数値だけD列以降にコピペされ、 セルC1をスタートに C1が1、D1が2、E1が3・・・といったように、連番を振りたいのですが、 下記プログラムで実行すると、inputboxで入力された数値分、表はコピペされますが、 肝心な連番が振られず1行目は空白のままになってしまいます。 ------------------------------------------------------------------------------ Dim cp As Long, x As Integer Dim ren As Integer 答え1 = InputBox("拠点数を入力してください。", "拠点数入力") ia = Val(答え1) Application.ScreenUpdating = False Range("C1:C10").Copy For cp = 1 To ia - 1 Cells(1, x + 4).PasteSpecial x = x + 1 Next With Application .CutCopyMode = False .ScreenUpdating = True End With ren = 1 Range("C1").Select Do While ActiveCell.Offset(0, 1).Value <> "" ActiveCell.Value = ren ren = ren + 1 ActiveCell.Offset(1).MergeArea.Select Loop どう修正すれば良いのか分かりません。 宜しくお願い致します。
- ベストアンサー
- Visual Basic
- guchan2020
- 回答数2