フォームモジュールの内容 Option Compare Database Option Explicit Private pintCurPage As Integer 'カレントページのカウンタ Private Sub cmd次ページ_Click() '[次の10件]ボタンクリック時 '表示するページ番号をインクリメント pintCurPage = pintCurPage + 1 'マップの表示処理 cbfRefreshMap True End Sub Private Sub cmd先頭_Click() '[先頭へ]ボタンクリック時 '表示するページ番号を初期化 pintCurPage = 1 'マップの表示処理 cbfRefreshMap True End Sub Private Sub cmd前ページ_Click() '[前の10件]ボタンクリック時 '表示するページ番号をデクリメント pintCurPage = pintCurPage - 1 'マップの表示処理 cbfRefreshMap True End Sub Private Sub マップ中心住所_AfterUpdate() 'マップ中心住所の更新後処理 'マップの表示処理 cbfRefreshMap True End Sub Private Sub マップ縮尺_AfterUpdate() 'マップ縮尺の更新後処理 'マップの表示処理 cbfRefreshMap True End Sub Private Sub Form_Load() 'フォーム読み込み時 'WebブラウザコントロールのURLを設定 Me!wbマップ.ControlSource = "=""" & CurrentProject.Path & "\index.html""" '表示するページ番号を初期化 pintCurPage = 1 'マップの表示処理 cbfRefreshMap False End Sub Private Sub cbfRefreshMap(blnRefreshFlg As Boolean) 'マップの表示処理 Dim cnn As New ADODB.Connection Dim rst As New ADODB.Recordset Dim strm As New ADODB.Stream Dim strSQL As String Dim strData As String Dim intRecordCnt As Integer If pintCurPage < 1 Then Beep MsgBox "先頭ページです!", vbOKOnly + vbExclamation pintCurPage = 1 Exit Sub End If 'テーブルからマーカーの住所情報を取得して組み立て Set cnn = CurrentProject.Connection With rst strSQL = "SELECT 名前, 住所 FROM tbl住所情報 ORDER BY ID" .Open strSQL, cnn, adOpenStatic, adLockReadOnly, adCmdText .PageSize = 10 '1回当りの表示件数 If pintCurPage > .PageCount Then '総ページ数を超えているとき Beep MsgBox "最終ページです!", vbOKOnly + vbExclamation pintCurPage = pintCurPage - 1 .Close: Set rst = Nothing cnn.Close: Set cnn = Nothing Exit Sub End If .AbsolutePage = pintCurPage '今回表示するページ番号 strData = "" For intRecordCnt = 1 To .PageSize If .EOF Then Exit For strData = strData & _ IIf(Len(strData) > 0, "," & vbCrLf, "") & _ "['" & !住所 & "','" & !名前 & "', 1]" .MoveNext Next intRecordCnt .Close: Set rst = Nothing End With cnn.Close: Set cnn = Nothing '画面より中心住所と縮尺を取得して組み立て strData = "var mapzoom = " & Nz(Me!マップ縮尺, 10) & ";" & vbCrLf & _ "var places = [" & vbCrLf & _ "['" & Me!マップ中心住所 & "', """", 0]," & vbCrLf & _ strData & vbCrLf & _ "];" & vbCrLf '組み立てたデータをmapdata.jsに書き出し With strm .Charset = "UTF-8" .Open .WriteText strData .SaveToFile CurrentProject.Path & "\mapdata.js", adSaveCreateOverWrite .Close: Set strm = Nothing End With 'Webブラウザコントロールを最新情報に更新 If blnRefreshFlg Then Me!wbマップ.Refresh End If End Sub |
Copyright © T'sWare All rights reserved |