[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『WebAPIを使用を判定し日付変換』(吉信)
inputBOXで範囲選択しても日付が出ません 原因解明ができませんお助けを!!
Option Explicit
'日付入力
Private Sub CommandButton1_Click()
Dim tmp As String
'キャンセルが押された場合は処理を終了する On Error GoTo myError tmp = Application.InputBox("列を選択して下さい", "列の選択", Type:=8).Address On Error GoTo 0
Dim monthStart As Long '月初の日付 Dim monthEnd As Long '月末の日付
monthStart = 1 monthEnd = Day(DateSerial(Year(Date), Month(Date) + 1, 0))
Range(tmp).Select
Dim y As Long Dim x As Long Dim col As Long '選択した列番号 Dim row As Long '選択した行番号 Dim strYear As String Dim strMonth As String Dim strDay As String Dim activeDate As String Dim activeDateFmat As String
Dim apiUrL As String 'apiのURL apiUrL = "http://s-proj.com/utils/checkHoliday.php?kind=h&date="
'列が選択されていた場合 If Selection.Address = Selection.EntireColumn.Address Then
col = Selection.Column
For y = monthStart To monthEnd Cells(y, col).Value = y
strYear = Year(Date) strMonth = Month(Date) strDay = y activeDate = strYear & "/" & strMonth & "/" & strDay '日付の区切りを取り除く activeDateFmat = Format(activeDate, "yyyymmdd")
'日付から曜日の数値を取得 tmp = Weekday(activeDate) '曜日の数値から曜日を取得(Trueで曜日名を省略) tmp = WeekdayName(tmp, True) '日付の隣のセルに曜日を入れる Cells(y, col + 1).Value = tmp
'休日か祝日の場合は日付を赤色にする If CheckHoliday(apiUrL & activeDateFmat) = "holiday" Then Cells(y, col).Font.ColorIndex = 3 End If Next
Else '行が選択されていた場合 If Selection.Address = Selection.EntireRow.Address Then
row = Selection.row
For x = monthStart To monthEnd Cells(row, x).Value = x
strYear = Year(Date) strMonth = Month(Date) strDay = x activeDate = strYear & "/" & strMonth & "/" & strDay '日付の区切りを取り除く activeDateFmat = Format(activeDate, "yyyymmdd")
'日付から曜日の数値を取得 tmp = Weekday(activeDate) '曜日の数値から曜日を取得(Trueで曜日名を省略) tmp = WeekdayName(tmp, True) '日付の隣のセルに曜日を入れる Cells(row + 1, x).Value = tmp
'休日か祝日の場合は日付を赤色にする If CheckHoliday(apiUrL & activeDateFmat) = "holiday" Then Cells(row, x).Font.ColorIndex = 3 End If Next End If End If
myError:
End Sub
'祝休日の判定
Function CheckHoliday(ByVal apiUrLAddPra As String)
'XMLHttpRequestオブジェクトを作成 Dim HttpReq As Object Set HttpReq = CreateObject("MSXML2.XMLHTTP")
HttpReq.Open "GET", apiUrLAddPra, False HttpReq.send (Null)
'戻り値(祝休日の場合holiday、それ以外はelseを返す) CheckHoliday = HttpReq.responseText
Set HttpReq = Nothing
End Function
< 使用 Excel:Excel2019、使用 OS:Windows10 >
ところで、これはあなたが書いたものではないでしょう?
出典を明記されたほうがよいと思います。
(γ) 2020/09/19(土) 22:56
ところで、
Inputboxが出たときに、どうされています?
列であれば、例えば「B」という列文字が表示されている部分をクリックして、
Inputbox内の表示が
$B:$B
となっていますか?
ひょっとして、B1:B30などを選択していないかと思ったまでです。
ステップ実行して、自分の想定している動きからはずれるところはどこか、確認して下さい。
私の手元では正常動作しています。
あとは環境ですけど。(参照設定せよと書いてあるが、別にしなくても動作はしますね)
とりあえず、上記の点、もう一度確認します。
(γ) 2020/09/20(日) 07:10
# 手元のExcel2010,2019いずれでも成功していますから
# ちょっとした手違いだろうと思います。
(γ) 2020/09/20(日) 08:30
'列が選択されていた場合 If Selection.Address = Selection.EntireColumn.Address Then col = Selection.Column For y = monthStart To monthEnd Cells(y, col).Value = y では、最初の分岐はどちらに実行が移って行きましたか? col = Selection.Column や、次のFor文は実行されましたか?
Cells(y, col).Value = y が実行されると、アクティブシートに 日が書き込まれるはずですね。 ステップ実行したなら、そのあたりを確認して返事して下さい。
(γ) 2020/09/20(日) 08:51
祝休日であるかどうかをサイトに照会するところ以前の問題なので、
頑張って下さい。
(γ) 2020/09/20(日) 09:02
あつもり先生本人が使う分にはそれでいいんでしょうが、 使いにくくないですかね。
元になる日付データ(yyyy/m/d)も、単なる日(d)に変えられちゃいます。 列全体とか行全体とかを選択する方式って、首を傾げたくなります。 日付の処理も回りくどい印象があります。
吉信さん自身の表で、どこに何をしたら、どういう日が出て欲しいのか、 その説明をして頂く方が無駄がないような気がします。
あと、どこで休日を取って来るのか面倒なのでチェックしてないですが、 自社で使う休日と完全合致しているんですか?
※通常、そんなラッキーな事ってないと思うんですが。
(半平太) 2020/09/20(日) 15:37
For y = monthStart To monthEnd Cells(y, col).Value = y d = DateSerial(Year(Date), Month(Date), y) tmp = Format(d, "aaa") '曜日(月,火等) Cells(y, col + 1).Value = tmp
'休日か祝日の場合は日付を赤色にする activeDateFmat = Format(d, "yyyymmdd") If CheckHoliday(apiUrL & activeDateFmat) = "holiday" Then Cells(y, col).Font.ColorIndex = 3 End If Next みたいな書き方をしそうですね。
また、
HttpReq.send (Null)
というのも少し違和感がありました。
無指定のデフォルトで Nullになりますから、
敢えて書かないことのほうが多いように思います。
たしかVariant型を渡すので、あえてカッコをつけているんでしょうけど、
その辺も間違いのもとになるので、書かない方が無難だと思います。
それはそうと質問者さんは解決されたのでしょうか。
(γ) 2020/09/20(日) 16:51
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.