アクセスの表示方法についての質問
- アクセスのフォームで10件づつ表示する方法
- 帳票形式でデータが一部表示されない問題への対処法
- 「前へ」と「次へ」ボタンを利用して10件づつの表示を実現する方法
- ベストアンサー
アクセスのフォームで10件づつ表示する。
初めて書き込みさせて頂きます。 アクセスのテーブルを帳票形式にて作成して10件づつ表示をさせようとすると一部のデータが表示されません。 方法としては、帳票形式で10件のみ表示出来る様にサイズを調整して「前へ」と「次へ」のボタンをつけて10件づつ表示させています。 ソースは下記の方法で 「次へ」 Private Sub コマンド13_Click() Dim rs As DAO.Recordset, i As Integer Const n As Integer = 10 Set rs = Me.RecordsetClone For i = 1 To n * 2 If rs.EOF Then rs.MoveLast Me.Bookmark = rs.Bookmark Exit Sub End If rs.MoveNext Next Me.Bookmark = rs.Bookmark For i = 1 To n rs.MovePrevious Next Me.Bookmark = rs.Bookmark rs.Close End Sub 「前へ」 Private Sub コマンド16_Click() Dim rs As DAO.Recordset, i As Integer Const n As Integer = 10 Set rs = Me.RecordsetClone For i = 1 To n * 2 If rs.BOF Then rs.MoveFirst Me.Bookmark = rs.Bookmark Exit Sub End If rs.MovePrevious Next Me.Bookmark = rs.Bookmark For i = 1 To n rs.MoveNext Next Me.Bookmark = rs.Bookmark rs.Close End Sub 以上、ご教授の程宜しくお願い致します。
- t_cusl2
- お礼率12% (1/8)
- その他(データベース)
- 回答数4
- ありがとう数2
- みんなの回答 （4）
- 専門家の回答
質問者が選んだベストアンサー
前回のコードはちょっと間違い。 下記でどうかな。 Const n = 10 '「次へ」 Private Sub コマンド13_Click() Dim p As Long On Error Resume Next DoCmd.GoToRecord , , acNext, n * 2 If Err = 2105 Then p = Me.CurrentRecord DoCmd.GoToRecord , , acLast DoCmd.GoToRecord , , acGoto, p + n Else DoCmd.GoToRecord , , acPrevious, n End If End Sub '「前へ」 Private Sub コマンド16_Click() DoCmd.GoToRecord , , acPrevious, n * 2 If Err = 2105 Then p = Me.CurrentRecord DoCmd.GoToRecord , , acFirst DoCmd.GoToRecord , , acGoto, p - n Else DoCmd.GoToRecord , , acNext, n End If End Sub
その他の回答 (3)
- 30246kiku
- ベストアンサー率73% (370/504)
質問者さん 私に騙されてみる気はありますか。 以下の方法は、私がいろいろやってみて、何か動きそう・・・ というレベルのもので、Microsoft の資料等裏付けが取れていないものになります。 確認用フォームは、添付図の様になります。 （フォームウィザードから表形式として作ったものになります） 「an」「日付」「Src」を連結した帳票で、 ボタン、前に「btnPrev」、次に「btnNext」がヘッダに配置されたものになります。 VBAで、以下を記述します。 Const CSCRLNUM As Long = 10 Private Sub Form_Load() Me.InsideHeight = Me.Section(acHeader).Height _ + Me.Section(acDetail).Height * CSCRLNUM _ + Me.Section(acFooter).Height End Sub Private Sub ScrollByMyself(iNum As Long) Dim i As Long, j As Long If (Me.Dirty Or Me.NewRecord) Then Exit Sub j = Abs(iNum) With Me.RecordsetClone .MoveLast .Bookmark = Me.Bookmark i = .AbsolutePosition + iNum If (i < 0) Then i = 0 ElseIf (i >= .RecordCount) Then i = ((.RecordCount - 1) \ j) * j ElseIf ((i Mod j) <> 0) Then i = (i \ j) * j End If .AbsolutePosition = i Me.an.SetFocus ' ★詳細にあるコントロール「an」にフォーカス移動 Me.Bookmark = .Bookmark i = (Me.CurrentSectionTop - Me.Section(acHeader).Height) _ + Me.Section(acDetail).Height i = i \ Me.Section(acDetail).Height If (i > 0) Then DoCmd.GoToPage 1, , Me.Section(acDetail).Height * i End If End With End Sub Private Sub btnPrev_Click() ' 前へ Call ScrollByMyself(-CSCRLNUM) End Sub Private Sub btnNext_Click() ' 次へ Call ScrollByMyself(CSCRLNUM) End Sub ※ ★ の、詳細にあるコントロールにフォーカスを移動しないと、まともに動きません。 上記では「an」にしましたが、「日付」でも「Src」でも・・・・ フォーカスが詳細にあることが重要です。 上記の細かい説明は、ここではしません。 ※ 本質問とは別の用途ですが、ブログに記事として載せてます。 アドレスは書けない、導くキーワードの提示も規約で禁止されているので書けません。 興味あったら探してみてください。 なお、上記を確認してみる・・・・使ってみようかな・・・・ すべて自己責任にてお願いします。
- hatena1989
- ベストアンサー率87% (378/433)
たびたび、済みません。「前へ」のコードに不足がありましたので、訂正します。 Const n As long = 5 Private Sub コマンド13_Click() Dim p As Long On Error Resume Next DoCmd.GoToRecord , , acNext, n * 2 If Err = 2105 Then p = Me.CurrentRecord DoCmd.GoToRecord , , acLast DoCmd.GoToRecord , , acGoTo, p + n Else DoCmd.GoToRecord , , acPrevious, n End If End Sub Private Sub コマンド16_Click() Dim p As Long On Error Resume Next DoCmd.GoToRecord , , acPrevious, n * 2 If Err = 2105 Then p = Me.CurrentRecord DoCmd.GoToRecord , , acFirst DoCmd.GoToRecord , , acGoTo, p - n Else DoCmd.GoToRecord , , acNext, n End If End Sub
- hatena1989
- ベストアンサー率87% (378/433)
コードを見る限りは問題点は見当たらないですが、「一部のデータが表示されない」とは具体的にどのようになるのか詳細に説明してもらえますか。 蛇足ですが、かなり遠回りしているコードですね。 下記のようにシンプルに記述することもできます。 '「次へ」 Private Sub コマンド13_Click() On Error Resume Next DoCmd.GoToRecord , , acNext, 10 If Err = 2105 Then DoCmd.GoToRecord , , acLast End Sub '「前へ」 Private Sub コマンド16_Click() On Error Resume Next DoCmd.GoToRecord , , acPrevious, 10 If Err = 2105 Then DoCmd.GoToRecord , , acFirst End Sub
補足
「一部のデータが表示されない」について再度見てみると最後の部分が表示されません。 例えば38件データが有った場合10件の表示を３回行い、8件を最後に表示すれば良いのですが 最後は一番最後のレコードのみ表示されます。 以上、宜しくお願い致します。 また、教えて頂いたソースで試してみます。 ありがとうございました。
関連するQ&A
- エクセル、ワークシートが保護されているかどうかを判断するVBAは？
以下のように書いてもダメでした。 どう直せばよいでしょうか？ Sub TEST2() Dim n As Integer n = ThisWorkbook.Worksheets.Count For i = 1 To n If Worksheets(i).Protect = False Then MsgBox Worksheets(i).Name End If Next End Sub
- ベストアンサー
- オフィス系ソフト
- Excel VBAライフゲーム
ExcelのVBAでライフゲームを作りたいのですが、次のプログラムの途中以降がわかりません。 もしよろしければ、このつづきの簡単な実行できるVBAライフゲームを教えてください。 続きのプログラムを教えていただけたら幸いです。 Option Explicit Const ALIVE As Integer = 1 Const DEAD As Integer = 0 Const SIZE As Integer = 19 Const Tmax As Integer = 100 Dim C(SIZE, SIZE) As Integer Sub LifeGame() Dim InitRate As Single Dim T As Integer Dim N As Integer Dim Cnext(SIZE, SIZE) As Integer Dim I As Integer, J As Integer InitRate = -1 Do While InitRate < 0 Or 1 < InitRate Loop For I = 0 To SIZE For J = 0 To SIZE If Rnd() < InitRate Then C(I, J) = ALIVE Else C(I, J) = DEAD End If Next J Next I For T = 1 To Tmax For I = 0 To SIZE For J = 0 To SIZE If C(I, J) = ALIVE Then Cells(I + 1, J + 1).Value = "■" Else Cells(I + 1, J + 1).Vallue = "" End If Next J Next I For I = 0 To SIZE For J = 0 To SIZE N = Count(I, J) Next J Next I For I = 0 To SIZE For J = 0 To SIZE C(I, J) = Cnext(I, J) Next J Next I Next T End Sub Function Count(I As Integer, J As Integer) As Integer End Function
- ベストアンサー
- SE・インフラ・Webエンジニア
- インプットボックスのキャンセル処理
インプットボックスのキャンセルを押したときに「型が一致しません」というエラーがでてしまいます。いろいろ調べてみてはいるのですが分かりません。教えて下さい。 Sub 指定した行数を挿入() Dim TopRow As Integer, CntRow As Integer, InstRows As Integer Dim i As Integer, ii As Integer, n As Integer Sheets("Sheet1").Select Rows("7:7").Select TopRow = ActiveCell.Row CntRow = Selection.Rows.Count n = InputBox("行数を入力して下さい。", "指定した行の挿入") If ｎ = "" Then Exit sub End if InstRows = n For i = 1 To CntRow Rows(TopRow + (i - 1) * (InstRows + 1)).Select For ii = 2 To InstRows Selection.EntireRow.Insert Next ii Next i End Sub
- ベストアンサー
- Visual Basic
- ExcelのVBAで下線部分の取得・文字の挿入
画像のように、Ａ列の文字をＣ列のようにしたいと考えています。 http://okwave.jp/qa/q4307830.htmlを参考に以下のコードとしました。 Sub test01() Dim i As Integer, n As Integer, s As Integer, l As Integer i = Len(ActiveCell) For n = 1 To i If ActiveCell.Characters(n, 1).Font.Underline <> xlNone Then s = n Exit For End If Next If s > 0 Then For n = s + 1 To i If ActiveCell.Characters(n, 1).Font.Underline = xlNone Then l = n - 1 Exit For End If Next End If If l = 0 Then l = i End If MsgBox "開始点：" & s & vbCrLf & "終了点：" & l End Sub ところが、Ａ５，Ａ６の処理がうまくいきません。また、"["や"]"の挿入の方法もわかりません。 教えていただければ幸いです。よろしくお願いいたします。 使用OS：Windows7 使用ソフト：Microsoft Excel 2000～2010
- ベストアンサー
- その他（プログラミング・開発）
- Access2003 入力フォームの表示検索について
フォームに非連結のボックスを作成し、以下のようなコードを追加し検索用に作成したのですが、 これが不味いのか、稀にデータの修正を行うと違うデータがTabキーもしくは矢印キーの移動で変わってしまいます。 例： ID1 店名 A店 住所 A県 代表者 A様 このデータの店名ボックスの店名をB店に変え、Tabや矢印で 次のボックスに移動すると、 ID1 店名 B店 住所 C県 のように関係ないデータが表示され、さらに移動すると 代表者 C様 と別のデータが移動するごとに表示されてしまいます。 （関係の無い別のIDデータが表示される。） なぜこのようなことが起きるのでしょうか？ もし分かる方回答のほどお願いします。 企業コード（検索するフィールド） テキスト_ID検索（ボックス名） Private Sub テキスト_ID検索_AfterUpdate() Dim rs As DAO.Recordset If IsNumeric(Me.テキスト_ID検索) Then Set rs = Me.RecordsetClone rs.FindFirst "企業コード=" & Me.テキスト_ID検索 If rs.NoMatch Then '番号が見付からなかった場合の処理 MsgBox "データが見付かりません。" Else Me.Bookmark = rs.Bookmark End If rs.Close End If End Sub
- 締切済み
- オフィス系ソフト
- Workbook
次のプログラムをExcelのWorkbookで開くやり方がよくわかりません。 どうやってやるのか教えていただけないでしょうか？ Option Explicit Const ALIVE As Integer = 1 Const DEAD As Integer = 0 Const BORN As Integer = 3 Const LIFE As Integer = 2 Const SIZE As Integer = 20 Const Tmax As Integer = 100 Dim C(SIZE, SIZE) As Integer Dim Xrange As Variant Private Sub LifeGame() Dim InitRate As Single Dim T As Integer Dim I As Integer, J As Integer Randomize Xrange = Range("A1:T20") InitRate = 0.5 For I = 1 To SIZE For J = 1 To SIZE If Rnd() < InitRate Then C(I, J) = ALIVE Else C(I, J) = DEAD End If Next J Next I For T = 1 To Tmax For I = 1 To SIZE For J = 1 To SIZE If C(I, J) = ALIVE Then Xrange(I, J) = "■" Else Xrange(I, J) = "" End If Next J Next I Range("A1:T20") = Xrange For I = 1 To SIZE For J = 1 To SIZE C(I, J) = Cnext(I, J) Next J Next I Next T End Sub Function Cnext(I As Integer, J As Integer) As Integer Dim xi As Integer Dim xj As Integer Dim xsum As Integer For xi = I - 1 To I + 1 For xj = J - 1 To J + 1 If (xi > 0 And xi <= SIZE) _ And (xj > 0 And xj <= SIZE) Then If Not (xi = I And xj = J) Then If C(xi, xj) = ALIVE Then xsum = xsum + 1 End If End If End If Next Next Select Case xsum Case BORN Cnext = ALIVE Case LIFE Cnext = C(I, J) Case Else Cnext = DEAD End Select End Function Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Call LifeGame End Sub
- ベストアンサー
- SE・インフラ・Webエンジニア
- vba boolean変数を開放する方法
エクセルのセルに「○○○○○○○○○○××××××××××」と入っているものをランダムに並べ代えるマクロを探してみました。 Sub macro2() Dim i, m As Integer Dim b, c As String Dim flg(1 To 20) As Boolean b = Cells(1, 1).Value Randomize For i = 1 To 20 Do m = Int(20 * Rnd + 1) If flg(m) = False Then flg(m) = True Exit Do End If Loop c = c & Mid(b, m, 1) Next i Cells(1, 2).Value = c End Sub これはうまく動くのですが、10行分やろうとして、以下のように変更すると暴走（終わらない）します。 Sub macro2() Dim i, m, n As Integer Dim b, c As String Dim flg(1 To 20) As Boolean For n = 1 To 10 b = Cells(n, 1).Value Randomize For i = 1 To 20 Do m = Int(20 * Rnd + 1) If flg(m) = False Then flg(m) = True Exit Do End If Loop c = c & Mid(b, m, 1) Next i Cells(n, 2).Value = c next n End Sub 一行目が終わってもboolean変数の値がそのまま残っているのが原因らしいのですが開放する方法がわかりません。 取りあえずもう一つマクロを追加してやりたいことはできたのですが、 Sub macro1() Dim n As Integer For n = 1 To 10 Call macro2(n) Next n End Sub Sub macro2(n As Variant) 以下略 なんかスッキリしません。 boolean変数を開放し、マクロひとつですます方法を教えて頂きたくお願いします。 flg(m) = Falseを挿入してもダメでした。
- ベストアンサー
- Excel（エクセル）
- VBのGUI 行列の和を求める
VBのGUIです。 行列の足し算を行うプログラムをつくりたいです。 以下のプログラムはできたところまで作成しています。 □個の□行□列（□はテキストボックス）の所に例えばユーザーが3 3 3と入力したとします。 ボタン１を押すと3×3の3個個分のテキストボックスがでてきて、要素を打ち込めるようになります。 そしてユーザが要素を打ち込みます。次に要素が 1 2 1 2 1 2 2 1 2 2 1 2 1 2 1 1 2 1 1 2 1 2 1 2 1 2 1 というように入力されたとします。 ボタン２を押すと ３×３のテキストボックスが出てきて この３つの行列の和を足した 5 4 5 4 5 4 4 5 4というようにテキストボックスに表示されるようにしたいです。 ３この３行３列の和だけでなく何個の何行何列の場合でもできるようにしたいです。 どのようなソースでこのプログラムはできるのでしょうか。 Public Class Form1 Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Me.Bounds = New Rectangle(10, 10, 1300, 800) Dim number As Integer Dim rows As Integer Dim columns As Integer If Not Integer.TryParse(TextBox3.Text, number) Then MessageBox.Show("数字で入力してください", Me.Text, MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Sub End If If Not Integer.TryParse(TextBox1.Text, rows) Then MessageBox.Show("数字で入力してください", Me.Text, MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Sub End If If Not Integer.TryParse(TextBox2.Text, columns) Then MessageBox.Show("数字で入力してください", Me.Text, MessageBoxButtons.OK, MessageBoxIcon.Error) Exit Sub End If For k = 1 To number For i = 1 To rows For j = 1 To columns Dim tb As TextBox = New TextBox() tb.Name = "R" & i.ToString() & "C" & j.ToString() & "No" & k.ToString() Me.Controls.Add(tb) tb.Top = (i - 1) * 30 + 80 tb.Left = (j - 1) * 60 + 70 * (columns * (k - 1)) + 10 tb.Width = 50 Next Next Next End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click Dim number As Integer Dim rows As Integer Dim columns As Integer Dim r As Integer Dim n As Integer Dim m As Integer Dim sum As Double sum = 0 For n = 1 To columns For m = 1 To rows sum = 0 For r = 1 To number Next For i As Integer = 1 To rows For j As Integer = 1 To columns Dim tb As TextBox = New TextBox() tb.Name = "R" & i.ToString() & "C" & j.ToString() Me.Controls.Add(tb) tb.Top = (i - 1) * 30 + 80 tb.Left = (j - 1) * 60 + 10 tb.Width = 40 Next Next Next Next End Sub End Class
- 締切済み
- Visual Basic
- ユーザーフォームに教えてください！
病院に勤めている者ですが、今エクセルで患者さまデータを作成しており、ユーザーフォームを使って患者さま情報を一目みてわかるようにしています。オートフィルターとスクロールバーを同期させてテキストバックスに反映させるようにしているのですが、ユーザーフォームに入力すれば直接セルに入力できるようにするにはどうしたら良いでしょうか。記述は下記のとおりです。 Private Sub ScrollBar1_Change() SelectRow For i = 1 To 65 Me.Controls("textbox" & CStr(i)).Value = Selection.Cells(1, i) Next End Sub Private Sub UserForm_Initialize() ScrollBar1.Min = 1 ScrollBar1.Max = CountRows() ScrollBar1.LargeChange = ScrollBar1.Max \ 10 + 1 ScrollBar1.Value = 1 SelectRow For i = 1 To 65 Me.Controls("textbox" & CStr(i)).Value = Selection.Cells(1, i) Next End Sub Sub SelectRow() Dim iRows As Long iRows = 0 For i = 5 To ActiveSheet.UsedRange.Rows.Count If Not Rows(i).Hidden Then iRows = iRows + 1 If iRows = ScrollBar1.Value Then ActiveSheet.Rows(i).Select Exit For End If End If Next i End Sub Function CountRows() As Long Dim iRows As Long iRows = 0 For i = 1 To ActiveSheet.UsedRange.Rows.Count If Not Rows(i).Hidden Then iRows = iRows + 1 End If Next i CountRows = iRows End Function 具体的な記述があればありがたいです！
- 締切済み
- Visual Basic
- エクセル2003(VBA)で違うフォームのチェックボックス配列を繰り返し処理したい
エクセル2003(VBA)で違うフォームのチェックボックス配列を 元に順番に繰り返し処理したいのですが、うまくいきません。 どうかお知恵をお貸し下さい。 よろしくお願いします。 ■<ユーザーフォーム1>(本体フォーム) Private Sub CommandButton1_Click() UserForm2.Show Dim n As Integer Dim ender As Integer ender = 1 i = 1 For n = 1 To 20 If i > 4 Then i = 1 '4を超えたら1に戻る If cb(i).Value = False Then 'チェックがなかったら飛ばす i = i + 1 '次の配列へ n = n - 1 'ループ回数をカウントしないように1引く Else Worksheets("sheet1").Cells(ender, 5).Select Worksheets("sheet1").Cells(ender, 5) = "■" & cb(i).Caption & " = " & cb(i).Value ender = ender + 1 i = i + 1 End If Next n End Sub ■<ユーザーフォーム2>(チェックボックスフォーム) Private Sub CommandButton1_Click() Const cb_num = 4 'チェックボックスを4個に設定 Dim cb(cb_num) As Control Dim ctrl As Control Dim i As Integer i = 0 For Each ctrl In Me.Controls 'コントロールの数だけループする If TypeName(ctrl) = "CheckBox" Then 'タイプがチェックボックスなら i = i + 1 If i > cb_num Then Exit For 'チェックボックスの数を超えたコントロールは無視 Set cb(i) = ctrl 'コントロールを配列に代入 End If Next ctrl End Sub
- ベストアンサー
- Visual Basic
お礼
早速のご回答ありがとうございます。実施してみて何かありましたら改めてご質問させて頂きます。
補足
ご回答有難うございます。 DoCmd.GoToRecord , , acPrevious, n * 2 If Err = 2105 Then p = Me.CurrentRecord DoCmd.GoToRecord , , acFirst DoCmd.GoToRecord , , acGoto, p - n Else DoCmd.GoToRecord , , acNext, n End If End Sub の方で実行時エラー2105が発生しました。何がいけないのでしょうか？