今までこのシリーズで説明してきたルールを踏襲しつつ、実際にVBAでコードを書いてみます。

今回は、以下のように都市別の天気予報をAPIで取得してシート上に描画する、といったものを作ってみます。

天気予報APIはこちらを使わせていただきました。

APIのURLの末尾に都市IDを付与してリクエストすることで、数日分の天気予報データをJSON形式で返してくれます。
　https://weather.tsukumijima.net/api/forecast/city/400040
　

今回のプログラムの仕様

都市名、都市IDは「都市別天気予報」シートのテーブル上に予め記載しておく
ボタンを押すと上記テーブルの都市IDをもとにAPIで天気予報を取得
上記テーブルに当日の天気予報を描画し、それに合わせたアイコンも描画

モジュール構成

まずは機能ごとにモジュールを分割します。

今回の主な機能は2つです。それぞれ以下の名前でモジュールを作っています。
　・APIで天気予報を取得（WeatherDataFetcher）　
　・結果を描画（ResultDrawer）

これに加えて、上記モジュールを呼び出すためのコントローラ的なモジュール、
天気予報データを格納するクラスもあると良さそうです。

また、定数定義用のモジュール、複数プロジェクトで使いまわせる共通関数を記載したモジュールも組み込みます。

以上を踏まえて、今回は以下のようになりました。

なお、JsonConverter（VBA-JSON）はサードパーティー製のフリーウェアです。
取得した天気予報データはJSON形式なので、これを簡単に読み込むために組み込んでいます。

定数を定義

コードの実装に入ります。
まずは定数をConstantsに定義していきます。
今回は列番号やAPIに関する情報を定義しています。

Constants

Option Explicit

'======================================================
'
' 定数定義用モジュール
'
'======================================================


'======================================================
' API
'======================================================

' 天気予報APIURLの接頭辞 末尾に都市IDが付く
Public Const WEATHER_API_URL_PREFIX = "https://weather.tsukumijima.net/api/forecast/city/"

' JSONキー 天気予報一覧
Public Const JSON_KEY_FORECAST = "forecasts"

' JSONキー 日付
Public Const JSON_KEY_DATE = "date"

' JSONキー 天気名
Public Const JSON_KEY_TELOP = "telop"

'======================================================
' 「都市別天気予報一覧」シート 列番号
'======================================================

' テーブル内列番号 都市名
Public Const LO_CITY_NAME_CLM = 1

' テーブル内列番号 都市ID
Public Const LO_CITY_ID_CLM = 2

' テーブル内列番号 天気
Public Const LO_WEATHER_CLM = 3

'======================================================
' 天気予報アイコン
'======================================================

' アイコン貼り付け時のX方向のマージン
Public Const ICON_X_MARGIN = 10

' アイコン貼り付け時のY方向のマージン
Public Const ICON_Y_MARGIN = 6

'======================================================
' 図形
'======================================================

' 図形名 更新ボタン
Public Const SHAPE_UPDATE_BUTTON = "更新ボタン"

都市IDをシートから取得

処理を実装していきます。
最初にAPIを使うための都市IDをシートから取得します。
都市IDは以下のようにシート上に手動で記載しておくものとします。

このシート内に都市IDの一覧を返すためのコードを組み込みます。

TownWeatherSheet

Option Explicit

'======================================================
'
' 天気予報一覧シート
'
' [索引]
'   □ 1. テーブルから都市IDの一覧を返す
'
'======================================================

' モジュール名
Const MODULE_NAME = "WFSheet"

' テーブル
Private TLo As ListObject

'======================================================
'
' 1. テーブルから都市IDの一覧を返す
'
'======================================================

' テーブルから都市IDの一覧を返す
'
' 戻値: Collection
'
Public Function getCityIdsFromLo() As Collection
    On Error GoTo ErrHdl
    Dim i, cid, cids As New Collection
        
    ' テーブルをセット
    Set TLo = Me.ListObjects(1)
    ' テーブルを走査
    For i = 1 To TLo.DataBodyRange.Rows.count
        cid = TLo.DataBodyRange(i, LO_CITY_ID_CLM)
        
        ' 都市IDをコレクションにセット
        If cid <> "" Then
            cids.Add cid
        End If
    Next
    
    Set getCityIdsFromLo = cids
ErrHdl:
    If Err.Number <> 0 Then
        Util.logError MODULE_NAME & ".getCityIdsFromLo", Err.Description
    End If
End Function

APIで天気予報データを取得

次に取得した都市IDをもとに、APIで天気予報をJSON形式で取得するモジュール、WeatherDataFetcherを実装します。
モジュール内の機能は処理ごとに関数に分割し、それぞれ分かりやすい名前を付けます。

WeatherDataFetcher

Option Explicit

'============================================================
'
' 対象都市の当日の天気予報をAPIから取得するモジュール
'
' [処理概要]
'   ・対象都市のAPIURLにアクセス
'       APIURL："https://weather.tsukumijima.net/api/forecast/city/" + 都市ID
'   ・JSON形式のテキストをJsonConverterで辞書型データに変換
' 　・WeatherDataクラスの値に当日の天気をセットして返す
'
' [索引]
'   □ 1. 対象都市の天気予報データを返す
'
'============================================================'

' モジュール名
Const MODULE_NAME = "WeatherDataFetcher"

' 対象都市の都市ID
Private TargetCityID As Long

' 対象都市のAPIURL
Private TargetCityAPIUrl As String

' APIから取得した結果のJSONデータ
Private JsonVal As Variant

' 対象都市の天気予報データ
Private TargetCityWeatherData As WeatherData

'======================================================
'
' 1. 対象都市の天気予報データを返す
'
'======================================================

' 対象都市の天気予報データを返す
'   ・初期処理（変数初期化 ＋ APIURLをセット）
'　 ・APIから結果をJSON形式で取得
'　 ・JSONデータから天気予報データをセット
'
' 引数： cid long 　 対象都市のID
' 戻値： WeatherData 対象都市の天気予報データ
'
Public Function getTargetCityWeatherData(ByVal cid As Long) As WeatherData
    On Error GoTo ErrHdl
    ' 都市IDをセット
    TargetCityID = cid

    ' 初期処理
    Call init
    ' APIから結果をJSON形式で取得
    Call setJsonValFromAPI
    ' JSONデータから天気予報データをセット
    Call setWeatherDataFromJSON

    Set getTargetCityWeatherData = TargetCityWeatherData
ErrHdl:
    If Err.Number <> 0 Then
        Util.logError MODULE_NAME & ".getTargetCityWeatherData", Err.Description
    End If
End Function

'======================================================
' 初期処理
'======================================================

' 初期処理
'　・対象都市のAPIURLをセット
'　・変数初期化
'
Private Sub init()
    On Error GoTo ErrHdl

    ' 対象都市のAPIURLをセット
    TargetCityAPIUrl = WEATHER_API_URL_PREFIX & TargetCityID
    ' 天気予報データの変数初期化
    Set TargetCityWeatherData = New WeatherData
ErrHdl:
    If Err.Number <> 0 Then
        Util.logError MODULE_NAME & ".init", Err.Description
    End If
End Sub

'======================================================
' APIから結果をJSON形式で取得
'======================================================

' APIから結果をJSON形式で取得
'  ・APIから結果をテキスト形式で取得し、JSONデータ形式にコンバート
'
Private Sub setJsonValFromAPI()
    On Error GoTo ErrHdl
    Dim resTxt
    
    ' APIから結果をテキストで取得
    resTxt = Util.getHTMLByHttp(TargetCityAPIUrl)
    ' JSONデータ形式にコンバート
    Set JsonVal = JsonConverter.ParseJson(resTxt)
ErrHdl:
    If Err.Number <> 0 Then
        Util.logError MODULE_NAME & ".setJsonValFromAPI", Err.Description
    End If
End Sub

'======================================================
' JSONデータから天気予報データをセット
'======================================================

' JSONデータから天気予報データをセット
'　・JSONデータから当日分の天気予報の値を取得
'　・WeatherData形式で日付、天気名、都市IDをセット
'
Private Sub setWeatherDataFromJSON()
    On Error GoTo ErrHdl
    Dim fDicts As Collection, fDict As Dictionary
    
    ' JSONデータから数日分の天気予報の値をセット
    Set fDicts = JsonVal(JSON_KEY_FORECAST)
    ' 1件目（当日）の天気予報の値をセット
    Set fDict = fDicts(1)

    ' 都市ID、天気名を天気予報データにセット
    With TargetCityWeatherData
        .CityID = TargetCityID
        .WeatherName = fDict(JSON_KEY_TELOP)
    End With
ErrHdl:
    If Err.Number <> 0 Then
        Util.logError MODULE_NAME & ".setWeatherDataFromJSON", Err.Description
    End If
End Sub

APIで取得したデータはJsonConverterを使用してコンバートしています。

また、HTTPアクセス部分は共通関数モジュールUtilに以下のように定義します。

Util

' HTTPリクエストの結果を文字列で返す
'
' 引数： url String
' 戻値： String
'
Public Function getHTMLByHttp(ByVal url As String) As String
    On Error GoTo ErrHdl
    Dim xmlHttp As Object, res As String
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
           
    getHTMLByHttp = ""
    
    With xmlHttp
        .Open "GET", url, False
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send
        res = .ResponseText
    End With
    
    getHTMLByHttp = res
ErrHdl:
    If Err.Number <> 0 Then
        Debug.Print (Err.Number & " " & Err.Description)
    End If
End Function

天気予報データ格納用クラスを作る

取得した天気予報データを格納するためのクラスWeatherDataを実装します。

WeatherData

'======================================================
' 天気予報データ
'
' [概要]
'　・APIから取得した1つの都市の天気予報データを格納
'======================================================

' モジュール名
Const MODULE_NAME = "WeatherData"

' 都市ID
Public CityID As Long

' 天気
Public WeatherName As String

データをクラスに格納するメリットは以下の通りです。

複数の変数をひとまとめにできる
連想配列と違ってコードの補完ができる

連想配列（辞書型）も1つの変数に複数のデータを格納できますが、配列のキーはコードの補完に対応していません。
クラス内で定義した変数は補完に対応しているのでとても使い勝手が良いです。

結果をシート上に書き出し

APIで取得した天気予報をシートに書き込むモジュール、ResultDrawerを実装します。

ResultDrawer

Option Explicit

'======================================================
'
' 「都市別天気予報一覧」シート描画用モジュール
'
' [処理概要]
'   ・「都市別天気予報一覧」シートの都市IDに対応する天気予報をテーブルに書き込む
'
' [索引]
'   □ 1. 「都市別天気予報一覧」シートの天気を描画
'
'======================================================

' モジュール名
Const MODULE_NAME = "ResultDrawer"

' 都市別天気予報データ　辞書型　キー = "都市ID"
Private WeatherDatasDict As Dictionary

' 書き込み先シート
Private OSheet As Worksheet

' テーブル
Private TLo As ListObject

'======================================================
'
' 1. 「都市別天気予報一覧」シートの天気を描画
'
'======================================================

'「都市別天気予報一覧」シートの天気を描画
'
' 引数: wDict Dictionary 都市別の天気予報データ
'
Public Sub redrawForeCasts(ByRef wDict As Dictionary)
    On Error GoTo ErrHdl
    Set WeatherDatasDict = wDict

    ' 画面の更新を停止
    Application.ScreenUpdating = False

    ' シート上の天気アイコン画像を削除
    Call clearSheetIcons
    ' テーブルの天気予報を再描画
    Call writeForeCastsToLO
    
    ' 画面の更新を再開
    Application.ScreenUpdating = True
ErrHdl:
    If Err.Number <> 0 Then
        Util.logError MODULE_NAME & ".redrawForeCasts", Err.Description
    End If
End Sub

'======================================================
' シート上の天気アイコン画像を削除
'======================================================

' シート上の天気アイコン画像を削除
'　・更新ボタン以外の図形をすべて削除
'
Private Sub clearSheetIcons()
    On Error GoTo ErrHdl
    Dim sp As Shape
    
    ' 更新ボタン以外の図形をすべて削除
    For Each sp In TownWeatherSheet.Shapes
        If sp.name <> SHAPE_UPDATE_BUTTON Then
            sp.Delete
        End If
    Next
ErrHdl:
    If Err.Number <> 0 Then
        Util.logError MODULE_NAME & ".clearSheetIcons", Err.Description
    End If
End Sub

'======================================================
' テーブルの天気予報を再描画
'======================================================

' テーブルの天気予報を再描画
'   ・テーブルを走査し、該当都市IDの天気予報データが存在すれば天気名を描画
'
Private Sub writeForeCastsToLO()
    On Error GoTo ErrHdl
    Dim cid, i, d As WeatherData
    ' テーブルをセット
    Set TLo = TownWeatherSheet.ListObjects(1)
    
    ' テーブルを走査
    For i = 1 To TLo.DataBodyRange.Rows.count
        ' 該当行の都市IDを文字列でセット
        cid = CStr(TLo.DataBodyRange(i, LO_CITY_ID_CLM))
        
        ' 同じIDの天気予報データがあれば
        If WeatherDatasDict.Exists(cid) Then
            Set d = WeatherDatasDict(cid)
            ' 該当行に天気名を描画
            TLo.DataBodyRange(i, LO_WEATHER_CLM) = d.WeatherName
            ' 該当行にアイコンをコピー
            Call copyTargetWeatherIcon(i, d.WeatherName)
        ' 存在しなければ空欄に
        Else
            TLo.DataBodyRange(i, LO_WEATHER_CLM) = ""
        End If
    Next
ErrHdl:
    If Err.Number <> 0 Then
        Util.logError MODULE_NAME & ".writeForeCastsToLO", Err.Description
    End If
End Sub

' 天気アイコンを該当行にコピー
'　・「天気アイコン一覧」シートから天気名と同名の画像を取得し、該当行にコピー
'　・コピー後、指定のマージン分移動
'
' 引数： i     Long
'        wName String
'
Private Sub copyTargetWeatherIcon(ByVal i As Long, ByVal wName As String)
    On Error GoTo ErrHdl
    Dim isp As Shape, dCell As Range, osp As Shape
    
    ' コピー元図形をセット
    Set isp = IconSheet.Shapes(wName)
    ' 図形をコピー
    isp.Copy
    ' コピー先セルをセット
    Set dCell = TLo.DataBodyRange(i, LO_WEATHER_CLM)
    ' ペースト
    With TownWeatherSheet
        .Paste Destination:=dCell
    
        ' 貼り付けた画像をセット
        Set osp = .Shapes(.Shapes.count)
        ' 座標を移動
        osp.left = dCell.left + ICON_X_MARGIN
        osp.top = dCell.top + ICON_Y_MARGIN
        
        ' A1セルを選択（図形の選択を解除）
        .cells(1, 1).Select
    End With
ErrHdl:
    If Err.Number <> 0 Then
        Util.logError MODULE_NAME & ".writeForeCastsToLO", Err.Description
    End If
End Sub

また、各天気のアイコンは別シートに画像であらかじめ用意し、各アイコンの名前を「晴れ」「曇り」などに変えておきます。

他モジュール呼び出し用のコントローラ作成

上記のモジュール、WeatherDataFetcher、ResultDrawerを呼び出すためのコントローラ的なモジュールを実装します。

MainController

Option Explicit

'============================================================
'
' 各主要都市の天気予報API URL取得用モジュール
'
' [処理概要]
'  ・「都市別天気予報一覧」シートから各都市の都市IDをセット
'  ・各都市の当日の天気予報をAPIで取得
'  ・「都市別天気予報一覧」シートに天気を描画
'
' [索引]
'   □ 1. 天気予報の描画処理実行
'
'============================================================'

' モジュール名
Const MODULE_NAME = "MainController"

' 各都市の都市ID一覧
Private CityIds As Collection

' 都市別の天気予報データ 辞書型 キー = "都市ID"
Private WeatherDatasDict As Dictionary


'======================================================
'
' 1. 天気予報の描画処理実行
'
'======================================================

' 天気予報の描画処理実行
'　・シートから各都市の都市IDをセット
'　・各都市の天気予報データをAPIで取得
'　・シートに天気予報を描画
'
Public Sub exec()
    On Error GoTo ErrHdl

    ' シートから各都市の都市IDをセット
    Call setCityIdsFromSheet
    ' 各都市の天気予報データをAPIで取得
    Call fetchTargetCitiesWeatherDatas
    ' シートに天気予報を描画
    Call ResultDrawer.redrawForeCasts(WeatherDatasDict)
ErrHdl:
    If Err.Number <> 0 Then
        Util.logError MODULE_NAME & ".exec", Err.Description
    End If
End Sub

'======================================================
' シートから各都市の都市IDをセット
'======================================================

' シートから各都市の都市IDをセット
'　・「都市別天気予報一覧」シートから都市IDをセット
'
Private Sub setCityIdsFromSheet()
    On Error GoTo ErrHdl

    '「都市別天気予報一覧」シートから都市IDをセット
    Set CityIds = TownWeatherSheet.getCityIdsFromLo
ErrHdl:
    If Err.Number <> 0 Then
        Util.logError MODULE_NAME & ".exec", Err.Description
    End If
End Sub

'======================================================
' 各都市の天気予報データを取得
'======================================================

' 各都市の天気予報データを取得
'　 ・各都市の天気予報データを取得し、辞書型データにセット。キー = "都市ID"
'
Private Sub fetchTargetCitiesWeatherDatas()
    On Error GoTo ErrHdl
    Dim wd As WeatherData, key, cid
    ' 変数初期化
    Set WeatherDatasDict = New Dictionary

    ' 都市IDの件数ループ
    For Each cid In CityIds
        ' 該当都市の天気予報データを取得
        Set wd = WeatherDataFetcher.getTargetCityWeatherData(cid)
        
        ' キーをセット。都市IDの文字列形式
        key = CStr(wd.CityID)
        ' 辞書型データにセット
        Set WeatherDatasDict(key) = wd
    Next
ErrHdl:
    If Err.Number <> 0 Then
        Util.logError MODULE_NAME & ".fetchTargetCitiesWeatherDatas", Err.Description
    End If
End Sub

MainController.execを実行すると他モジュールが呼び出され、一連の処理が実行されるようになっています。
この関数はシート上のボタン押下時に動作するように紐づけておきます。

これで実装完了です。

動作を確認

ボタンを押して動作を確認します。
問題なく天気が書き込まれ、アイコンも貼り付けることができています。