ぼくLog

子持ち、車持ち、マンション持ちの僕の日常を綴ります。車と、ラクをしたい一心で覚えたエクセルVBAを中心になりそうです。

サピックス6年生家庭学習のスケジュール管理

サピックス6年生課程の家庭学習量は5年生までと段違い。 家庭学習の進捗管理をしっかり行わないとすぐに学習課題山積で子ども&親が途方に暮れること必至。

なので、進捗管理の徹底を決意。 使うツールは最終的に Google Spreadsheet に落ち着いた。 このまま最後(=受験)まで走り切る。

4年生課程からいくつかのタスク管理方法を試した。

4年生の時は、簡易的なエクセル表。 5年生の時は、Trelloでカンバン方式、ホワイトボード。

エクセルとTrelloはいずれも、自分=親の立場の進捗管理こそ出来たが、子どもを巻き込むことが出来なかった。

いずれもスマホで見れはするけど、やっぱパソコンじやないと使いづらく。。。 子どもは見たくもないタスク表のためにわざわざパソコン開かないよね〜。

子どもが使わない・見ない進捗管理方法は親の自己満足に過ぎす、子どもの能力アップの観点では意味ナシ!

やるべきこと=タスクが見えて、それを完了させる=消していく。その達成感を得ながら勉強するほうが子どもは楽しい。

で、アナログなホワイトボードを導入。 教科を縦方向、曜日を横方向にマス目を作って、日々やることを書き出し、それが終わっら横線を入れていく。

フォートナイト(Epic Games)のアカウントとPSN(PlayStation Network)のアカウント接続を変更することは可能!

フォートナイトのアカウント(正確には Epic Games のアカウント)をPSNアカウントに接続した後に、

 

あ!このアカウントじゃない!!間違えてもうた!!!

 

ってなったお話です。

 

フォートナイト ラスト・ラフ バンドル - Switch

フォートナイト ラスト・ラフ バンドル - Switch

  • 発売日: 2020/11/17
  • メディア: Video Game
 

 

 

結論を先に言うと、本来あるべきアカウントに接続し直すことは可能です。

ただし条件付きです。

 

(子どものために)PS5をゲット!早速フォートナイトをインストール。早くプレイがしたい!っていう我が子のプレッシャーで気が急いていたのか、自分のPSNアカウントでフォートナイトを開いてたのにも関わらず、初回に求められるアカウント接続時に子どものフォートナイトアカウントに接続。

つまり自分のPSNアカウントと我が子のフォートナイトアカウントを繋げてしまったのです。


あ!ヤベ!!と思いつつひと通りフォートナイトを楽しんだ後、「さぁ、アカウント接続を直すか!」と思ってやり方をググったら何やら出来なさそうな雰囲気。

 

まずは Epic Games のFAQ見ると、異なるアカウントに接続し直すことは不可と仰る。えぇぇ、、

www.epicgames.com

試しに、EpicのマイページからPSNの接続を切ろうとしようものなら、オドロオドロシイ警告文が表示されます。

ざっくり言うとオマエすべてを失うゼ、BAN!。そう言われます。玉ヒュンです。

 

他に方法がないかと探しても、接続切るとPSで二度とそのフォートナイトアカウントでプレイできないとか言うし、、、

【フォートナイト】アカウントの解除方法を解説。好きなアカウントとデバイスをリンクしよう【Fortnite】 | 寝ても覚めても

 

途方に暮れました。

そしたらあるじゃないですか、Epic Games の問い合わせ窓口

US-NCの企業で、日本語サイトあるもののチョイチョイ日本語おかしいから日本語通じるか不安だったけど、とりあえず日本語で事情説明を入力し送信。

 

しばらくしたらメール返信があり、アカウント接続の変更はできる、と。神か。しかもサポートの方は日本人のようで普通の日本語で返ってきました。

ただしアカウント接続変更は原則1年に1回のみ、とのこと。

いやもう二度としません!誓います!!

 

その後、サポートの方の指示どおりに手続きを踏んで無事アカウント接続変更完了!!

問い合わせ送信後メール2~3往復しましたがクイックレスポンスではないので大体1日かかりました。

この間、メールの度にサポートの方が替わっていきましたが、いずれも非常に誠実な文面。アカウントBANされるんじゃないかっていう不安感を拭い去ってくれます。ほんと感謝感謝。

 

これで我が子もフォートナイトを楽しめます!

自分も子ども一緒にデュオとかやるので自分も楽しめます!!

 

プレイステーション ストアチケット 1,100円|オンラインコード版
 

 

子どもと一緒に英会話でパパママも英語上達!子どもとペアレッスンできる英会話教室

自分は英語が出来ないけれど、子どもに話せるようになって欲しい。

そう思っているのはぼくだけではないハズ。
全く以って親の身勝手そのものです(猛省)

ただ子どもを英会話に通わせるのではなく、どうせなら自分も一緒に通って英語苦手意識も克服しちゃいましょう!!


親子で学ぶ英会話

子どもは親を見て育つ!

言うまでもありません。子どもは親を見て育ちます。
悪い部分も含めて親の影響を多分に受けます(汗

自分が「英語苦手だなー」「しゃべれないなー」となっていれば、それが子どもに伝播して当たり前。
英語が苦手とか言ってる場合ではありません。
英語を学んで触れて楽しんでいる姿を見せてあげましょう!
そうすれば子どもは一緒に楽しんで英語を吸収してくれます。ついでに自分も英語が上達しちゃいます。


親子のコミュニケーションが増加!

一緒に外遊びする、モノを作る、映画を見る。そして自然と会話が弾む。
親子にとってかけがえのない時間です。

でも同じことをやっているとすぐマンネリ化。刺激が欲しくなってきます。
子どもは楽しければいくらでも同じことをエンドレスでやり続けられますが、大人にとってはそれに苦痛になることも。。。
かといって子どもと一緒にできる何か新しいものはないかなー、って探してもそう簡単にポンポン見つかるものではありません。

英語を「一緒に学ぶ」。
これを親子の時間に組み込むことで、これまでとは違う時間を共有することができます。

普段の生活の中で拙いながらも英語で会話する。
そして「それ違うない?こうじゃない?」なーんで指摘が子どもから聞こえて来たら。
嬉しくなってニンマリしちゃいますよね。


普段から英語を使う機会が増加。英語に触れる頻度が上達のカギ!

英語が身に付かないのは、何より英語に触れる時間が少ないから。
日本語だってそれにずっと触れ続けてるから子どもも覚えるわけです。
大人は英語に触れる時間が少ないことを頭でカバーしますが、その状態では「自然と口から英語が出てくる」には程遠く。

普段の生活の中で自然と英語で話す機会が増える。
これ、間違いなく英語の上達にとってプラスです。
子どもを英会話に通わせてるけど上達してる感じがしない。自分も英会話に通ってるけど海外に行って話せる気がしない。
そんな悩みも一気に解決です。


親子で学べる英会話スクール

イングリッシュ・ヴィレッジ / English Village

f:id:yt4u:20190814215226p:plain
イングリッシュビレッジ

イングリッシュ・ビレッジ はマンツーマン、自由予約制、かつ2,100円/40分~という低料金なので、自分のレベル・目的・スケジュールに合った方法で、効率的・経済的に着実なレベルアップが図ることが可能です。

マンツーマンが基本スタイルのスクールではありますが、ペアツーマンコースが用意されています。
このペアツーマンコースを親子で利用することが可能。しかも1人1,050円/40分~、つまり2人で2,100円/40分~と非常にリーズナブル。

f:id:yt4u:20190814221240p:plain
イングリッシュビレッジ|プラン

また、都内に11校・横浜に1校の12校あって、都内から通いやすいのも魅力です。

f:id:yt4u:20190814215556p:plain
イングリッシュビレッジ|スクール


シェーン英会話

f:id:yt4u:20190814230531p:plain
シェーン英会話

シェーン英会話は子ども向けのプランが充実していますので、すでに子どもを通わせているケースもあると思います。

加えて、月謝性ペアレッスンコースが用意されていますので、これを親子で利用することも可能です。

f:id:yt4u:20190814231132p:plain
シェーン英会話


ECC外語学院

www.ecc.jp

ECC外語学院はペアレッスンを提供していませんが、家族で入学すると全員入学金免除という嬉しい特典があります。

ECC外語学院家族割
ECC外語学院家族割


親子英会話でモチベーションアップ

子どもを英会話教室に通わせてるけど、子どもは楽しんでないし、かつ何のために通ってるのかイマイチ理解していない。なんて状態は非常に不幸なこと。
であれば、親である自分も一緒に英会話に参加して、一緒に楽しむ。これほどまでに子どもにとってポジティブに作用することなんて他にありません。
親が一緒にいることで子どもは安心して英会話スクールに通えますし、スクール外でも親子で英語話す機会が格段に増えるわけですから、英語の吸収スピードは一気に向上します。

親子で英会話スクールを探す際は「ペアレッスン」をキーワードに探してください。

オススメはイングリッシュ・ビレッジ です。

公式サイト:満足度99.1%!コスパ業界最高クラスの英会話教室【イングリッシュ・ビレッジ】

イングリッシュ・ビレッジは首都圏でのスクール展開となっていますので、近くにスクールがない場合はシェーン英会話が近くにあるかを探してみると良いと思います。

公式サイト:大手英会話スクール【シェーン英会話】

セルの名前の定義の使い方を覚えると確実に作業効率アップ!|エクセルVBA

エクセルVBAでセルを参照する時、こんな書き方してませんか?

  Dim x As String

  x = Range("A1").Value
  x = Cells(1, 1).Value


結論を先に言うと、こういう書き方をしていると間違いなく時間を浪費することになります


参照セルの位置が変わることなんて日常茶飯事

先ほどの書き方でも例外にOKなのは、参照セルがそこから絶対変わらないの場合。

すべてを綿密にカッチリ決めてVBAを書き始めたならそれも可能です。

でもそんなことは稀ですよね。

例えば、作成途中でのシートレイアウトの変更。
セルをカット&ペースト、行・列の追加。その結果セルが移動することは日時茶飯事。

そうなると必然的にVBAの書き換えが必要になります。

これ、効率が悪いことは明らかですよね。


じゃあどうするか??


ここで名前の定義の登場です。


セルに名前を付けることでVBAが効率的に!

セルに名前を付けるのは簡単。

メニューバーの下に「名前ボックス」があります。

f:id:yt4u:20190720165901j:plain

ここに好きな名前を打ち込んであげればOK。


例えば日付を入れるセルに「rngB_DateFrom」と名前を付けます。

f:id:yt4u:20190720171247j:plain


簡単ですね。


VBAでこのセルを参照したい場合は

  Dim datFrom As Date

  datFrom = wsBoku.Range("rngB_DateFrom").Value

これでセルから日付を取得することが可能。


で、何より重要なのはセルが移動する場合
例えば、列の挿入が必要になって先ほどのセルが2列目から3列目に移動した場合。

f:id:yt4u:20190720171254j:plain

セルが動いても名前との紐付きは変わっていません。
そのためVBAの書き換えは不要です。


一方、セルの番地を使った書き方をしていた場合、書き換えが必要になります。

  Dim datFrom As Date

  datFrom = wsBoku.Cells(2, 2).Value
  
  '↑Cells(2, 2) を Cells(3, 2) に書き換える必要が出てくる

セルの位置が変わる度にVBAを書き換えなきゃならないなんて大変ですよね。

だから名前の定義を活用するんです。


セルのコピー&ペーストの時は名前は付いて来ない

先ほどのように列を挿入(削除)した、あるいは行を挿入(削除)した、その結果、セルが移動した場合、セルと名前の紐付き関係は変わりません。

また、セルをカット&ペーストした場合も、セルと一緒に名前を付いてきます。


ただ、セルのコピー&ペーストの時は名前は付いてきません

この点は注意しておきましょう。


「名前の管理」で名前の管理?!

セルに付けた名前の管理は「名前の管理」画面で出来ます。

f:id:yt4u:20190720174516j:plain

メニュー「数式」>「名前の管理」で開くことが出来ますが、「Ctrl + F3」ショートカットでも開けるので是非覚えておきましょう

この「名前の管理」で修正、削除、あるいは新規作成が可能です。

ここで「範囲」が「ブック」となっていますが、これは名前がブックにぶら下がったものであることを表しています。

もう少し正確に言うと、セルに「名前」を付けることはNameオブジェクトを作ることと同義です。
その観点から整理すると、最初「名前ボックス」でセルに名前を付けましたが、それによりNameオブジェクトが作成され、そのNameオブジェクトの名前が「rngB_DateFrom」であり、Nameオブジェクトが持つ値や参照範囲が「名前の管理」で確認できるわけです。

このNameオブジェクトは基本的にWorkbookオブジェクトのメンバーとして作成されます。
ややこしいのはこのNameオブジェクトはWorksheetオブジェクトのメンバーにもなる、ということです。


例えば、先ほど名前を付けたセルがあるシートをコピーしてから「名前の管理」を見ると、まったく同じ名前を持つNameオブジェクトが作られていることが確認できます。

f:id:yt4u:20190720175220j:plain

ただし「範囲」が「ブック」ではなく、コピーされたシートになっています。
つまり、WorksheetのメンバーのNameであるということです。


これ、はっきり言ってダブルスタンダード状態で百害あって一利なしです。

WorksheetのNameが作られてしまった場合にはそれを全て削除し、WorkbookのNameで統一していくことをオススメします。

yt4u.hatenablog.com

エクセルデータベースにSQLでデータ追加!|エクセルVBA

f:id:yt4u:20180212111117j:plain

まず前編はこれ。

yt4u.hatenablog.com


ここでエクセルのシートをデータベースのテーブルと見なし、そこからデータを取得する方法をまとめたわけですが、今回は


データの追加もSQL使ってものすっごぉぉっく簡単に出来ちゃいますって話です。


前回同様この住所録を使って、ここにデータを追加してみたいと思います。

f:id:yt4u:20170102225905j:plain

(住所録はなんちゃって個人情報で生成したダミーデータです。)


データを追加するためのプロシージャを用意します

前回はGetRecordsetのプロシージャのみでしたが、データを追加(Execute)するためのプロシージャを用意します。

Private mstrErrDescription        As String

Private Const mcDataRangeName     As String = "rngXDB_DataBase"


'==========================================================
'Execute
'==========================================================
Public Function executeDB( _
                        ByRef objCN As Object, _
                        ByVal strSQL As String _
                        ) As Boolean
 
  
  executeDB = False
  
  
  On Error GoTo ERR_PROC
  
   
  objCN.execute strSQL
  
  
  executeDB = True
  
  
  GoTo END_PROC

ERR_PROC:

  mstrErrDescription = "Executeエラー"


END_PROC:
  
  
End Function


なお
Private mstrErrDescription As String
はエラー内容を返すための変数。


Private Const mcDataRangeName As String = "rngXDB_DataBase"
はシート上のデータテーブルに割り当てられたセル範囲名を示す定数。



データ追加してみます


で、早速データを追加してみます。

'==========================================================
'データ追加サンプル
'==========================================================
Public Sub addDataSample()

  Dim objCN             As Object
  Dim objRS             As Object
  Dim strSQL            As String
  Dim lngMaxNo          As Long
  
  
  'コネクションを確立
  
    Set objCN = GetXLSConnection(ThisWorkbook.FullName)
  
  
  'Noの最大値を取得
  
    strSQL = "SELECT"
      strSQL = strSQL & "  MAX([No]) AS MaxNo"
    strSQL = strSQL & " FROM " & mcDataRangeName
  
     
    If getRecordset(objCN, strSQL, objRS) = False Then
         
      GoTo ERR_PROC
    
    End If
  
  
    lngMaxNo = objRS!MaxNo
      
      
  
  '登録条件を作成
  
    strSQL = "INSERT INTO " & mcDataRangeName
    strSQL = strSQL & "("
      strSQL = strSQL & "  [No]"
      strSQL = strSQL & ", [名前]"
      strSQL = strSQL & ", [ふりがな]"
      strSQL = strSQL & ", [性別]"
      strSQL = strSQL & ", [年齢]"
      strSQL = strSQL & ", [誕生日]"
      strSQL = strSQL & ", [婚姻]"
      strSQL = strSQL & ", [血液型]"
      strSQL = strSQL & ", [都道府県]"
      strSQL = strSQL & ", [電話番号]"
      strSQL = strSQL & ", [携帯]"
      strSQL = strSQL & ", [キャリア]"
      strSQL = strSQL & ", [カレーの食べ方]"
    strSQL = strSQL & ")"
    strSQL = strSQL & "VALUES"
    strSQL = strSQL & "("
      strSQL = strSQL & "  " & lngMaxNo + 1
      strSQL = strSQL & ", '手酢十'"
      strSQL = strSQL & ", 'テスト'"
      strSQL = strSQL & ", '男'"
      strSQL = strSQL & ", 99"
      strSQL = strSQL & ", #2000/1/1#"
      strSQL = strSQL & ", '未婚'"
      strSQL = strSQL & ", 'AB型'"
      strSQL = strSQL & ", '東京都'"
      strSQL = strSQL & ", '00-0000-0000'"
      strSQL = strSQL & ", '999-9999-9999'"
      strSQL = strSQL & ", 'au'"
      strSQL = strSQL & ", '奥ルー・別口派'"
    strSQL = strSQL & ")"
  
  
    If executeDB(objCN, strSQL) = False Then
    
      GoTo ERR_PROC
    
    End If
  

  'データセル範囲を修正

    With wsXLSDataBase

      With .Range(mcDataRangeName)

        ThisWorkbook.Names.Add mcDataRangeName, .CurrentRegion

      End With

    End With
  
  
  GoTo END_PROC
  
ERR_PROC:

  MsgBox mstrErrDescription
  
  
END_PROC:
  
  'コネクションを閉じる
  
    Call CloseConnection(objCN)


End Sub


流れは、

  1. 新規追加するレコードのNoを現存するNoの最大値+1にするため、まずは現存するNoの最大値を取得
  2. 追加するレコードについてINSERT文を作成
  3. さっき用意したexecuteDBを実行してレコード追加。この時点でエクセルシート上にレコード追加完了
  4. データテーブルに割り当てられたセル範囲名(rngXDB_DataBase)の参照範囲を追加されたレコードを含むように修正



データ更新も可能です


INSERTが出来た次はUPDATEですね。

先ほどのデータテーブルでNoが最大値となっているレコードの名前をNULLにしたいと思います。


'==========================================================
'データ更新サンプル
'==========================================================
Public Sub updateDataSample()

  Dim objCN             As Object
  Dim objRS             As Object
  Dim strSQL            As String
  Dim lngMaxNo          As Long
  
  
  'コネクションを確立
  
    Set objCN = GetXLSConnection(ThisWorkbook.FullName)
  
  
  'Noの最大値を取得
  
    strSQL = "SELECT"
      strSQL = strSQL & "  MAX([No]) AS MaxNo"
    strSQL = strSQL & " FROM " & mcDataRangeName
  
     
    If getRecordset(objCN, strSQL, objRS) = False Then
         
      GoTo ERR_PROC
    
    End If
  
  
    lngMaxNo = objRS!MaxNo
  
  
  'Update文作成
  
    strSQL = "UPDATE " & mcDataRangeName
    strSQL = strSQL & " SET "
      strSQL = strSQL & "  [名前] = NULL"
    strSQL = strSQL & " WHERE 1 = 1 "
      strSQL = strSQL & " AND [No] = " & lngMaxNo
  
  
    If executeDB(objCN, strSQL) = False Then
    
      GoTo ERR_PROC
    
    End If

  
  GoTo END_PROC
  
ERR_PROC:

  MsgBox Err.Description
  
  
END_PROC:

  'コネクションを閉じる
  
    Call CloseConnection(objCN)


End Sub



レコードの削除もしちゃう?


INSERT、UPDATEと来たら次はDELETEですね。

これ、出来ません。
やろうとしても「この ISAM では、リンク テーブル内のデータを削除することはできません。」って怒られます。SHAZNAかよ!(古すぎて小声)




改めてコード全文を示します。

前回のコードも併せて改めて全文を載せます。


Option Explicit

Private Const adOpenDynamic       As Long = 2
Private Const adLockOptimistic    As Long = 3
Private Const adStateClosed       As Long = 0

Private mstrErrDescription        As String

Private Const mcDataRangeName     As String = "rngXDB_DataBase"


'==========================================================
'コネクションを返す
'==========================================================
Public Function GetXLSConnection(DataSource As String) As Object

  Dim objCN             As Object
  Dim strCNString       As String
  
  
  Set objCN = CreateObject("ADODB.Connection")
  
  
  strCNString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                        & "Data Source=" & DataSource & ";" _
                        & "Extended Properties=""Excel 8.0;" _
                        & "HDR=Yes"";"


  objCN.Open strCNString
  
  
  Set GetXLSConnection = objCN
  

End Function


'==========================================================
'GetRecordset
'==========================================================
Public Function getRecordset( _
                        ByRef objCN As Object, _
                        ByVal strSQL As String, _
                        ByRef objRS As Object _
                        ) As Boolean
 
  
  getRecordset = False
  
  
  On Error GoTo ERR_PROC
  
  
  Set objRS = CreateObject("ADODB.Recordset")
  
  
  objRS.Open strSQL, objCN, adOpenDynamic, adLockOptimistic
  
  
  getRecordset = True
  
  
  GoTo END_PROC

ERR_PROC:
      
  mstrErrDescription = "レコードセット生成エラー"


END_PROC:
  
  
End Function


'==========================================================
'Execute
'==========================================================
Public Function executeDB( _
                        ByRef objCN As Object, _
                        ByVal strSQL As String _
                        ) As Boolean
 
  
  executeDB = False
  
  
  On Error GoTo ERR_PROC
  
   
  objCN.execute strSQL
  
  
  executeDB = True
  
  
  GoTo END_PROC

ERR_PROC:

  mstrErrDescription = "Executeエラー"


END_PROC:
  
  
End Function


'==========================================================
'コネクション破棄
'==========================================================
Public Sub CloseConnection(objCN As Object)


  If objCN.State <> adStateClosed Then
  
    objCN.Close
  
  End If
  
  
  Set objCN = Nothing
  

End Sub


'==========================================================
'レコードセット破棄
'==========================================================
Public Sub CloseRecordSet(objRS As Object)


  If objRS.State <> adStateClosed Then
  
    objRS.Close
  
  End If


  Set objRS = Nothing
  
  
End Sub


'==========================================================
'データ取得サンプル
'==========================================================
Public Sub GetDataSample()

  Dim objCN             As Object
  Dim objRS             As Object
  Dim strSQL            As String
  Dim lngF              As Long
  
  
  'コネクションを確立
  
    Set objCN = GetXLSConnection(ThisWorkbook.FullName)
  
  
  '抽出条件を作成
  
    strSQL = "SELECT"                                           '抽出フィールド(項目)を指定
      strSQL = strSQL & "  [名前]"
      strSQL = strSQL & ", [ふりがな]"
      strSQL = strSQL & ", [電話番号]"
      strSQL = strSQL & ", MONTH([誕生日]) AS [誕生月]"
    strSQL = strSQL & " FROM " & mcDataRangeName                'データテーブルを指定
    strSQL = strSQL & " WHERE 1 = 1"                            '抽出条件
      strSQL = strSQL & " AND [性別] = '男'"                    '性別=男
      strSQL = strSQL & " AND [年齢] >= 30"                     '年齢=30歳以上
      strSQL = strSQL & " AND [年齢] <  50"                     '50歳未満
      strSQL = strSQL & " AND [婚姻] = '未婚'"                  '婚姻=未婚
  
  
  '抽出実行
     
    If getRecordset(objCN, strSQL, objRS) = False Then
         
      GoTo ERR_PROC
    
    End If
  
  
  '抽出結果を出力
  
    With wsXLSDataBase
    
      With .Range("rngXDB_DataTop")
      
        
        '出力エリアにある既存データを消去
        
          .CurrentRegion.ClearContents
          
        
        'フィールド(項目)名を出力
        
          For lngF = 0 To objRS.Fields.Count - 1
          
            .Offset(, lngF).Value = objRS.Fields(lngF).Name
          
          Next lngF
          
        
        'データを出力
        
          .Offset(1).CopyFromRecordset objRS
          
    
      End With
    
    End With
  
  
  GoTo END_PROC
  
ERR_PROC:

  MsgBox mstrErrDescription
  
  
END_PROC:

  'レコードセットを閉じる
  
    Call CloseRecordSet(objRS)
  
  'コネクションを閉じる
  
    Call CloseConnection(objCN)


End Sub


'==========================================================
'データ追加サンプル
'==========================================================
Public Sub addDataSample()

  Dim objCN             As Object
  Dim objRS             As Object
  Dim strSQL            As String
  Dim lngMaxNo          As Long
  
  
  'コネクションを確立
  
    Set objCN = GetXLSConnection(ThisWorkbook.FullName)
  
  
  'Noの最大値を取得
  
    strSQL = "SELECT"
      strSQL = strSQL & "  MAX([No]) AS MaxNo"
    strSQL = strSQL & " FROM " & mcDataRangeName
  
     
    If getRecordset(objCN, strSQL, objRS) = False Then
         
      GoTo ERR_PROC
    
    End If
  
  
    lngMaxNo = objRS!MaxNo
      
      
  
  '登録条件を作成
  
    strSQL = "INSERT INTO " & mcDataRangeName
    strSQL = strSQL & "("
      strSQL = strSQL & "  [No]"
      strSQL = strSQL & ", [名前]"
      strSQL = strSQL & ", [ふりがな]"
      strSQL = strSQL & ", [性別]"
      strSQL = strSQL & ", [年齢]"
      strSQL = strSQL & ", [誕生日]"
      strSQL = strSQL & ", [婚姻]"
      strSQL = strSQL & ", [血液型]"
      strSQL = strSQL & ", [都道府県]"
      strSQL = strSQL & ", [電話番号]"
      strSQL = strSQL & ", [携帯]"
      strSQL = strSQL & ", [キャリア]"
      strSQL = strSQL & ", [カレーの食べ方]"
    strSQL = strSQL & ")"
    strSQL = strSQL & "VALUES"
    strSQL = strSQL & "("
      strSQL = strSQL & "  " & lngMaxNo + 1
      strSQL = strSQL & ", '手酢十'"
      strSQL = strSQL & ", 'テスト'"
      strSQL = strSQL & ", '男'"
      strSQL = strSQL & ", 99"
      strSQL = strSQL & ", #2000/1/1#"
      strSQL = strSQL & ", '未婚'"
      strSQL = strSQL & ", 'AB型'"
      strSQL = strSQL & ", '東京都'"
      strSQL = strSQL & ", '00-0000-0000'"
      strSQL = strSQL & ", '999-9999-9999'"
      strSQL = strSQL & ", 'au'"
      strSQL = strSQL & ", '奥ルー・別口派'"
    strSQL = strSQL & ")"
  
  
    If executeDB(objCN, strSQL) = False Then
    
      GoTo ERR_PROC
    
    End If
  

  'データセル範囲を修正

    With wsXLSDataBase

      With .Range(mcDataRangeName)

        ThisWorkbook.Names.Add mcDataRangeName, .CurrentRegion

      End With

    End With

  
  GoTo END_PROC
  
ERR_PROC:

  MsgBox mstrErrDescription
  
  
END_PROC:
  
  'コネクションを閉じる
  
    Call CloseConnection(objCN)


End Sub


'==========================================================
'データ更新サンプル
'==========================================================
Public Sub updateDataSample()

  Dim objCN             As Object
  Dim objRS             As Object
  Dim strSQL            As String
  Dim lngMaxNo          As Long
  
  
  'コネクションを確立
  
    Set objCN = GetXLSConnection(ThisWorkbook.FullName)
  
  
  'Noの最大値を取得
  
    strSQL = "SELECT"
      strSQL = strSQL & "  MAX([No]) AS MaxNo"
    strSQL = strSQL & " FROM " & mcDataRangeName
  
     
    If getRecordset(objCN, strSQL, objRS) = False Then
         
      GoTo ERR_PROC
    
    End If
  
  
    lngMaxNo = objRS!MaxNo
  
  
  'Update文作成
  
    strSQL = "UPDATE " & mcDataRangeName
    strSQL = strSQL & " SET "
      strSQL = strSQL & "  [名前] = NULL"
    strSQL = strSQL & " WHERE 1 = 1 "
      strSQL = strSQL & " AND [No] = " & lngMaxNo
  
  
    If executeDB(objCN, strSQL) = False Then
    
      GoTo ERR_PROC
    
    End If

  
  GoTo END_PROC
  
ERR_PROC:

  MsgBox Err.Description
  
  
END_PROC:

  'コネクションを閉じる
  
    Call CloseConnection(objCN)


End Sub

SQL逆引き大全363の極意

SQL逆引き大全363の極意