「AccessVBA開発」カテゴリーアーカイブ

既に開いているフォーム(フォーム1)に対し、フォーム2から値を渡す(住所入力補助フォーム)

https://hosopro.blogspot.com/2017/09/access-vba-form-property.html

フォーム1>

‘メンバ変数
Private mRetnValue As String

‘プロパティ
Public Property Let RetnValue(ByVal Value As String)
mRetnValue = Value
End Property

Public Property Get c() As String
RetnValue = mRetnValue
End Property


Private Sub buttonOpen_Click()

mRetnValue = ""

DoCmd.OpenForm "フォーム2", acNormal, , , , acDialog

'フォーム2で選択した値をテキストボックスに表示
Me.textMessage.Value = mRetnValue

End Sub

フォーム2>

Private Sub buttonOK_Click()

Form_フォーム1.RetnValue = Me.comboFruits.Value

DoCmd.Close acForm, Me.Name

End Sub

デザインビューではコントロールが表示されるのに フォームビューで表示されない

表示されるレコードがなく、追加もできない(=新規レコードの枠が表示されない)状態
の場合、フォームビューの詳細領域にあるコントロールは、全て表示されなくなります。

これはAccessがそういう仕様になっているようなのでどうしようもないのですが、
詳細領域ではなくフォーム ヘッダ/フッタに設置したコントロールであれば表示は
されるので、表示レコードがない場合にも表示が必要なコントロール(フォームを閉じたり
表示を切り替えるコマンドボタンや、フォームの抽出条件を指定するテキストボックス等)
はフッタ/ヘッダに移動する、といった回避方法があります。

※本来表示させるレコードがない状態で、詳細領域のコントロールを強引に表示させる
  には、フォームのプロパティシートの『データ』タブで、『レコードセット』の設定を
  「ダイナセット (矛盾を許す)」にするという手もあります。
  但し、変な形でレコード編集がされてしまう危険性が生じますので、お勧めはできません。

参考
http://oshiete1.goo.ne.jp/qa3371589.html
http://oshiete1.goo.ne.jp/qa3028994.html

重複行のレコードに連番を振る

 '同じ製品番号が存在する場合は、行番号のフィールドに連番を振る。(重複なしは"1"とする)
strSQL = "SELECT 製品コード, 行番号 FROM W_製品添加物 ORDER BY 製品コード" '製品コードでソートする
Set rsW = DF_AdoNewRecordset(strSQL, adOpenStatic)

strCode = ""  '重複グループの変わり目を判定する変数
n = 1

If rsW.RecordCount > 0 And rsW.EOF = False Then
    Do Until rsW.EOF

        '製品コードが変わったとき
        If rsW!製品コード <> strCode Then
            n = 1
        End If
        '連番挿入
        rsW!行番号 = n
        '判定用の変数の値を更新
        strCode = rsW!製品コード
        '連番をインクリメント
        n = n + 1
        rsW.Update

        rsW.MoveNext
    Loop
End If
【参照】https://blog.goo.ne.jp/pc_college/e/9af70f574b22701225611def111c68be#_=_


このほか、Dcount関数を使った方法もあるが、上記がすっきりと早い!
【参照】https://hatenachips.blog.fc2.com/blog-entry-428.html
連番: DCount("ID","Tbl1","Group1=" & [Group1] & " AND Group2=" & [Group2] & " AND (Data1='" & [Data1] & "' AND ID<=" & [ID] & " OR [DATA1]<'" & [Data1] & "')")

(エラー:3342)サブクエリ ‘<サブクエリ名>‘ のメモ型または OLE オブジェクト型のデータが正しくありません。

サブクエリはメモ型 (Memo) または OLE オブジェクト型 (OLE Object) のデータを返せないため、式の中でメモ型 (Memo) または OLE オブジェクト型 (OLE Object) のデータと比較することはできません。

<対処方法>

データのフィールドサイズが255文字を超える場合、「長いテキスト」(メモ型)でフィールドを定義するけれど、このデータを活用しようとしてサブクエリでSELECTするとエラーが起きる。

SQLでUPDATEするときに、サブクエリとしてSELECT文で値を抽出せずに、別に、Dlookup関数等で、値を取得して代入する。

【WEHER句】の変数が文字列型
⇒ DLookup(“[更新日]”, “[Aテーブル]”, “[実施日]='” & last_date &”‘”)
【WEHER句】の変数が数値型
⇒ DLookup(“成分”, “TB_製品”, “行番号 = ” & lng行番号)

ADO Recordset で RecordCount プロパティが -1 を返す場合

参照設定に「Microsoft Active Data Object 2.0 Library」追加

また、デフォルトが以下なので、変更する。

rs.CursorLocation = adUseServer(デフォルト)

↓↓↓↓↓↓変更 ↓↓↓↓↓↓

rs.CursorLocation = adUseClient

Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient <— これを指定

※DAOのrecordcountで件数が取れないときはこちらを参照

または、コネクションでCursorLocationをクライアントサイドカーソルに変更して、RecordCountを取得する
dim connect, rs, count

Set connect = CreateObject("ADODB.Connection")
connect.Open "xxx"
connect.CursorLocation = 3 ' クライアントサイドカーソルに変更

Set rs = CreateObject("ADODB.Recordset")
rs.Open "SELECT * FROM HOGE(NOLOCK)", connect
If rs.eof Then
' 0件の場合の処理

End If
' RecordCountの取得
count = rs.RecordCount

rs.Close
Set rs = Nothing
http://replication.hatenablog.com/entry/20090312/1236866953

SQLServer のリンクテーブルをAccess側で作成

Access で、どこかの SQLServer へリンクテーブルが貼られている際に
dsnファイルを利用して、Access側でリンクテーブルを作成する。
dsnファイルの項目>
DRIVER
UID
DATABASE
WSID
APP
SERVER
example
ファイル名:@@@@.dsn
[ODBC]
DRIVER=SQL Server
UID=●●(:ID名)
DATABASE=●●●●(:DB名)
WSID=T●O●K●●●-CPU●●s
APP=Microsoft Data Access Components
SERVER=●●\SQLEXPRESS2017(:DBパス)
Accessのメニューで
外部データ>新しいデータソース>DBから>SQLサーバーから>「外部データの取り込み-ODBCデータベース」ウィンドウが開く

リンクテーブルを作詞えしてソースデータにリンクする>
データソース(@@@@.dsn)の場所を選ぶ

「SQLサーバーログイン」の画面が開くので、サーバーログインのID・PWを入力

リンクするテーブルを選択する
※SQLサーバーでは、テーブル名にdbo.がついて格納されている。

SQLサーバーの選択したテーブルにリンクされたテーブルが
Accessに作成される
※テーブル名にdbo.がついて作成されるので、テーブル名の変更が必要
<参照>
https://social.msdn.microsoft.com/Forums/sqlserver/ja-JP/9e164e23-3a79-4857-b213-3ff72c81c6b8/dsn125011244912452125231243421442327711239512522125311246312469?forum=sqlserverja
https://docs.microsoft.com/ja-jp/sql/relational-databases/linked-servers/create-linked-servers-sql-server-database-engine?redirectedfrom=MSDN&view=sql-server-ver15

空白文字だけの配列要素を後ろから削除する

‘空白文字だけの配列要素を後ろから削除する(配列途中の空白だけの要素(故意に改行した部分)は残す)

 最後の空行の改行については削除する (配列から要素を削除)
    '※空白(半角スペース・全角スペース)は、文字数1、バイト数2でカウントされる
    str配列要素 = ""
    i = UBound(v)
    j = 0
    cnt = 0
    Do
        If i = LBound(v) Then Exit Do

        For k = 1 To Len(v(i))
            If InStr(Mid(v(i), k, 1), " ") > 0 Then
                cnt = cnt + InStr(Mid(v(i), k, 1), " ")
            Else
                cnt = cnt + InStr(Mid(v(i), k, 1), " ")
            End If
        Next k
        If cnt <> Len(v(i)) Then Exit Do '空白以外の文字が存在すれば、抜ける
        If cnt = Len(v(i)) Then          'すべて空白
            v(i) = v(i - 1)
            j = j + 1
        End If
        cnt = 0
        i = i - 1
    Loop

    ReDim Preserve v(UBound(v) - j) '余分な配列要素を削除

    'str配列要素を再編成
    str配列要素 = ""
    i = 0
    j = 0

    For i = LBound(v) To UBound(v)
            j = j + 1
            If j = 1 Then
                str配列要素 = v(i)
            Else
                str配列要素 = str配列要素 & vbCrLf & v(i)
            End If
    Next i

Date型とDatetime型の違いに注意する。

DateTime型 (例) : KOUSINBI = #2004/01/14 17:51:00#
※DateTime型=300分の1秒で格納されている

’2009/01/01′の値が入っている該当項目を抽出したいときに
hoge_datetime が DateTime型 だったら、
以下のコードでは抽出できません。
SELECT * FROM hoge WHERE hoge_datetime = '2009/01/01'

convert関数を使って、キャストします。
SELECT * FROM busy WHERE Convert(NVARCHAR, hoge_datetime, 111) = '2009/01/01'
※ hoge_datetime項目を指定スタイル(111(4桁の年、日本、yy/mm/dd))にキャストし。

PageBreak プロパティを設定できません。(AccessVBAでエクセルをコピーするときに、出た)エラーの解消法

解消策としては
・一旦[標準]ビューで処理し、最後に[改ページプレビュー]設定する。
・ws_sheet2をActiveにして実行する。
・’* 改ページの挿入の直前に DoEvents を挿入する。
・Application.ScreenUpdating = False で実行する。
いずれでも解消するようです。

私は、コピー元のエクセルファイルを、改ページプレビューにしていたので、
標準ビューに戻したら、解決しました。

以下余談、ちょっと気になったこと。

ws_sheet3.Range(“1:10”).Copy
ws_sheet2.Range(“1:10”).PasteSpecial Paste:=xlPasteAll
xlPasteAllなら
ws_sheet3.Range(“1:10”).Copy ws_sheet2.Range(“1:10”)
でもいいかな、という点と
‘* sheet2 をクリア
なら
ws_sheet2.Cells(1, 1).Resize(9, 4).ClearContents
のほうがいいかな、という点です。