• 締切済み

Access ウィンドウサイズの変更

Access2000を使っています。 Accessを指定サイズで開く様にしたのですが、閉じる時に元のサイズに戻せないでしょうか。(次回別のAccessを開いた時に変更したサイズで開いてしまい困っています) 初心者の為、記述内容と記述する場所を教えて頂けると助かります。 開くときは下記の記述をしています。 Declarationsへ Declare Function MoveWindow Lib "user32" _ (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, _ ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long プロシージャへ Dim lngRet As Long lngRet = MoveWindow(Application.hWndAccessApp, 0, 0, 800, 600, True)

  • mmac
  • お礼率94% (64/68)

みんなの回答

  • O_cyan
  • ベストアンサー率59% (745/1260)
回答No.1

簡単な方法は 質問の内容の記述から見てフォームを開く時にモジュールから呼び出してサイズを変更しているようなので、フォームを閉じてAccessを終了する時にフォームの閉じる時のイベントに一度全画面表示するように して終了させれば、別のAccessを開くときに最大化されて表示されます。 フォームの閉じる時のイベントに DoCmd.Maximize で最大化します。 その後でフォームを閉じて終了させる。 またはDoCmd.MoveSizeを使用してサイズを指定して好きなサイズにしてから終了させる。 DoCmd.MoveSize Width:=1280, Height:=1024 とか または 別のAccessを開くときに起動時の設定などでフォームでも設定されていれば開く時のイベントに同様に記述すれば出来ます。

mmac
質問者

お礼

分かりやすい回答有難う御座いました。 サーバへ保管して各担当者が開いているのですが、 各担当者が、いつも開いているサイズと変わってしまうのが駄目らしく 何とかならないかと言われました。(自分以外のデータベースも有ります) 開いた時のサイズをテキストなどに保管して閉じる時にMoveSizeで元に戻せないでしょうか? とりあえずは教えて頂いた、Maximizeで閉じる事にします。

mmac
質問者

補足

開いた時のサイズを取り出す方法が分かりません。

関連するQ&A

  • MoveWindow

    現在、vb2008でウィンドウを管理するアプリケーションを製作しております。 本来ならほかのアプリケーションのウィンドウを操作しなければいけないわけですが、テストのために下のようなコードを実行しても希望した結果(Form2が画面いっぱいに表示される)になりません。 なお、Form2 FormBorderStyle はNoneで、最大化はされていません。 Public Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long Sub Test() Dim NewWin as New Form2 NewWin.Show() Dim Ptr As System.IntPtr = NewWin.Handle Dim Ret As Long = MoveWindow(Ptr.ToInt64d, 0, 0, _ Screen.PrimaryScreen.WorkingArea.Width, _ Screen.PrimaryScreen.WorkingArea.Height, 1) End Sub

  • アクセスでテキストを開く

    アクセスでパスを指定して、特定のテキストファイルを開く方法を教えていただけますか? いかのモジュールを見つけたのですが、どこに、動かないか… フルパスを入れればよいか分かりません。 どうぞ宜しくお願いします。 *********************************************************************************************** Private Declare Function ShellExecute Lib "SHELL32.DLL" Alias "ShellExecuteA" (ByVal hwnd As Long, _ ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _ ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Private Sub コマンド0_Click() Dim strFilePath As String Dim lngRet As Long Const SW_SHOWNORMAL = 1 strFilePath = Me.txt_Path 'WinAPIを使って関連付けられたアプリケーションを起動 lngRet = ShellExecute(Application.hWndAccessApp, "OPEN", _ strFilePath, vbNullString, CurDir(), SW_SHOWNORMAL) If lngRet <= 32 Then '返り値が 32 以下の場合はエラー MsgBox "ファイルを開けません!", vbOKOnly + vbExclamation End If End Sub ***********************************************************************************************

  • ExcelVBAでフォームのタイトルバーで右クリックした場合などに閉じるボタンが有効化されないようにするコード

    Excelのプログラムで、最小化ボタンを有効にし、閉じるボタンを無効にする質問をしたんですが、うまくいったと思ったのですがフォームが開き、タイトルバーで右クリックした場合などは閉じるボタンが有効化されてしまうのでこれを無効のままにするコードを教えてください。 作ったプログラムは以下の通りです。 標準モジュール Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function DrawMenuBar Lib "user32" _ (ByVal hWnd As Long) As Long Public Declare Function GetSystemMenu Lib "user32.dll" _ (ByVal hWnd As Long, ByVal bRevert As Long) As Long Public Declare Function EnableMenuItem Lib "user32" _ (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long Public Const MF_DISABLED = &H2& Public Const GWL_STYLE = (-16) Public Const WS_MINIMIZEBOX = &H20000 Public Const MF_BYCOMMAND = &H0& Public Const SC_CLOSE = &HF060& Dim hSysMenu As Long UserForm_Initializeプロシージャ Dim fRet As Long Dim hWnd As Long Dim fStyle As Long hWnd = FindWindow("ThunderDFrame", "UserForm1") fStyle = GetWindowLong(hWnd, GWL_STYLE) fStyle = (fStyle Or WS_THICKFRAME Or WS_MINIMIZEBOX) fRet = SetWindowLong(hWnd, GWL_STYLE, fStyle) hSysMenu = GetSystemMenu(hWnd, 0) EnableMenuItem hSysMenu, SC_CLOSE, MF_BYCOMMAND Or MF_DISABLED fRet = DrawMenuBar(hWnd) 回答よろしくお願いします。

  • 「コンパイルエラー End Subが必要です。」

    Access2016でファイルを作成しているのですが、下記のVBAを実行しようとすると、「コンパイルエラー End Subが必要です。」とエラーメッセージが返ってきてしまいます。 構文の修正が必要であるとお気づきであれば、その箇所を教えていただけないでしょうか。初歩的な質問で恥ずかしい限りですが、何卒よろしくお願い致します。 Option Compare Database Option Explicit Public Declare PtrSafe Function SetWindowPos Lib "user32" _ (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _ ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, _ ByVal fuFlags As Long) As Long Public Declare PtrSafe Function GetSystemMenu Lib "user32" _ (ByVal hWnd As Long, ByVal fRever As Long) As Long Public Declare PtrSafe Function RemoveMenu Lib "user32" _ (ByVal hMenu As Long, ByVal uItem As Long, ByVal fuFlags As Long) As Long Public Const SWP_NOMOVE = &H2 Public Const SWP_NOSIZE = &H1 Public Const HWND_TOP = &H0 Public Const SC_SIZE = &HF000 Public Const SC_MAXIMIZE = &HF030 Public Const SC_CLOSE = &HF060 Public Const SC_RESTORE = &HF120 Public Const MF_BYCOMMAND = &H0& Public Sub test() Private Sub Form_Open(Cancel As Integer) Dim hWnd As Long hWnd = Application.hWndAccessApp SetWindowPos hWnd, HWND_TOP, 0, 0, 800, 600, SWP_NOMOVE hWnd = GetSystemMenu(hWnd, 0) RemoveMenu hWnd, SC_SIZE, MF_BYCOMMAND End Sub

  • VB.net キャレットの幅の変更をしたい

    OS:Windows 7 64bit 開発環境:Visual Studio 2013 Express リッチテキストボックスでキャレットの幅を変更したいのですが、うまくいきません。 ------------------------------------------------------------- 'キャレットを作成する Private Declare Function CreateCaret Lib "user32" _ (ByVal hWnd As IntPtr, _ ByVal hBitmap As IntPtr, _ ByVal nWidth As Integer, _ ByVal nHeight As Integer _ ) As Boolean 'キャレットを表示する Private Declare Function ShowCaret Lib "user32" _ (ByVal hWnd As IntPtr) As Boolean Private Sub RichTextBox1_Enter(sender As Object, e As EventArgs) Handles RichTextBox1.Enter 'CreateCaret(RichTextBox1.Handle, IntPtr.Zero, 7, 15) CreateSolidCaret(5, 10) ShowCaret(RichTextBox1.Handle) End Sub ------------------------------------------------------------- 以上のようにして RichTextBox1 にフォーカスが来た時にキャレットの幅を変えるようにしているのですが、一度だけフォーカスが来た時にほんの一瞬だけ四角いキャレットが見えるのですが、すぐにI型に戻ってしまいます。 ググっても上記ソースくらいしか見つかりませんでした。 どなたかご享受願えませんでしょうか? よろしくお願い致します。

  • VBAでSetTextColorがうまくいかない

    EXCELのVBAでユーザーフォームを使ったグラフィック表示のプログラムを 作っているのですが、SetTextColorでテキスト色の設定をしようと してもうまくいきません。何故か設定しようとする色の値が無視されて 「1304008」が設定されてしまいます。(GetTextColorで確認) そしてそれ以降何を設定してもこの状態のままです。 何か考えられることがありますでしょうか。 下にそのプログラムを示します。 ちなみにSetBKColorやAngleArcなど他のグラフィック命令は問題なく 動いていてSetTextColorだけがうまくいってない状態です。 '------------------------------------------------- ' ユーザーフォーム用プログラム '------------------------------------------------- Private Declare Function GetActiveWindow Lib "user32" () As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpszClass As String, _ ByVal lpszWindow As String) As Long Private Declare Function GetDC Lib "user32" ( _ ByVal hWnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" ( _ ByVal hWnd As Long, _ ByVal hdc As Long) As Long Private Declare Function SetTextColor Lib "gdi32" _ (ByVal hdc As Long, crColor As Long) As Long Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" _ (ByVal hdc&, ByVal x&, _ ByVal y&, ByVal lpString$, ByVal nCount&) As Long Dim hWnd As Long Dim hdc As Long Public Sub UserForm_Activate() DoEvents hWnd = FindWindowEx(GetActiveWindow, 0, "F3 Server 60000000", "") hdc = GetDC(hWnd) ret = SetTextColor(hdc, RGB(255, 0, 0)) ret = TextOut(hdc, 0, 0, "abc", 3) Call ReleaseDC(hWnd, hdc) End Sub '-------------------------------------------------

  • windows7のエクスプローラをVBAで操作-1

    アドバイスをお願いします。 Excel-VBAで起動しているエクスプローラに対してハンドルを取得してクリックしたり、テキストボックスに文字をセットするプログラムを作って動かしています。 WindowsXPのときはできていたのですが、Windows7になったら正しく動作しなくなりました。 下のコードはエクスプローラの現在のフォルダパスが表示されるところに(添付ファイル参照)文字を入れるものです。 最後のSendMessageAnyで1が返ってしまいます。何が考えられますでしょうか。どう対策したらいいでしょうか。 なおハンドルの値はSDKのInspect Objectsで確認していますので、正しく取得できていると思っています。 よろしくお願いします。 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Declare Function SendMessageAny Lib "user32.dll" _ Alias "SendMessageA" _ (ByVal hwnd As Long, _ ByVal MSG As Long, _ ByVal wParam As Long, _ ByVal lParam As Any) As Long Const WM_SETTEXT = &HC Private hwnd As Long Private FOLDER As String Sub Put_folder_name1() hwnd = FindWindow("CabinetWClass", vbNullString) hwnd = FindWindowEx(hwnd, 0, "WorkerW", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ReBarWindow32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "Address Band Root", vbNullString) hwnd = FindWindowEx(hwnd, 0, "msctls_progress32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ComboBoxEx32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ComboBox", vbNullString) hwnd = FindWindowEx(hwnd, 0, "Edit", vbNullString) FOLDER = "\\xx.xx.xx.xx\test" RC = SendMessageAny(hwnd, WM_SETTEXT, 0, ByVal FOLDER) end sub

  • Formを動かせるようにしたい

    お世話になります。 OS XP PRO  VB6(SP5)で開発しています。 ディスプレイのサイズによりFormを動かせたり固定させたりしたいのですが、 規定値は固定にしたいのでFormプロパティのMoveableはFalseにしてあります。 下記のようにプログラミングしたのですが固定されたままです。 Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function GetSystemMenu Lib "user32" (ByVal _ hwnd As Long _ , ByVal bRevert As Long) As Long Private Declare Function RemoveMenu Lib "user32" ( _ ByVal hMenu As Long, ByVal nPosition As Long, _ ByVal wFlags As Long) As Long Private Declare Function DrawMenuBar Lib "user32" ( _ ByVal hwnd As Long) As Long Private Const MF_BYCOMMAND = &H0 Private Const SC_MOVE = &HF010 Private Sub Form_Load() Dim kk As Long kk = GetSystemMenu(.hwnd, bb) Call RemoveMenu(kk, SC_MOVE, MF_BYCOMMAND) Call DrawMenuBar(.hwnd) End Sub アドバイス頂きたくよろしくお願いします。 以上です。

  • windows7のエクスプローラをVBAで操作-2

    アドバイスをお願いします。 Excel-VBAで起動しているエクスプローラに対してハンドルを取得してクリックしたり、テキストボックスに文字をセットするプログラムを作って動かしています。 WindowsXPのときはできていたのですが、Windows7になったら正しく動作しなくなりました。 下のコードはエクスプローラのフォルダパスの右のボタン(添付ファイル参照)をクリックすべく、コーディングしたものです。 最後のSendMessage(hwnd, BM_CLICK, 0, 0) でクリックしたいのですが、その前にボタンのハンドルが取得できません。SDKのInspect Objectsで調べると、このボタンはClass="ToolbarWindow32"でName="前の場所"ですが、NativeWindowHandleが表示されず、Legacy.IAccessible.ChildID=1となっています。 このようなウィンドゥは別のやり方(IAccessible?)でないとクリックできないように感じていますが如何せん知識がありません。 どうしたらできるか、アドバイスよろしくお願いします。 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, lParam As Any) As Long Const BM_CLICK = &HF5 Private hwnd As Long Sub Click_button() hwnd = FindWindow("CabinetWClass", vbNullString) hwnd = FindWindowEx(hwnd, 0, "WorkerW", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ReBarWindow32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "Address Band Root", vbNullString) hwnd = FindWindowEx(hwnd, 0, "msctls_progress32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ToolbarWindow32", vbNullString) ' この次が分からない。 RC = SendMessage(hwnd, BM_CLICK, 0, 0) end sub

  • VBA ウィンドウの列挙 Win32 API

    http://d.hatena.ne.jp/cartooh/20090618 上記のページに記載されているVBAです。 動作は確認できたのですが、どのような処理の流れとなっているのかがわかりません。 どなたかコメントを付けていただけないでしょうか。 よろしくお願いいたします。 Option Explicit Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal cnm As String, ByVal cap As String) As Long Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, _ ByVal cch As Long) As Long Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, _ ByVal lParam As Long) As Long Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long Const INDENT_KEY = "INDENT" Public Function EnumChildWindowsProc(ByVal hWnd As Long, ByVal lParam As Object) As Long EnumChildWindowsProc = EnumWindowsProc(hWnd, lParam) End Function Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Object) As Long EnumWindowsProc = True If IsWindowVisible(hWnd) = 0 Then Exit Function End If Dim strClassName As String ' * 255 Dim strCaption As String ' * 255 strClassName = String(255, vbNullChar) strCaption = String(255, vbNullChar) GetWindowText hWnd, strCaption, Len(strCaption) GetClassName hWnd, strClassName, Len(strClassName) strCaption = RTrim(left(strCaption, InStr(1, strCaption, vbNullChar) - 1)) strClassName = RTrim(left(strClassName, InStr(1, strClassName, vbNullChar) - 1)) ActiveCell.Cells(1, 1).Value = Hex(hWnd) ActiveCell.Cells(1, 2).Value = IsWindowVisible(hWnd) ActiveCell.Cells(1, 3).Value = strCaption ActiveCell.Cells(1, 4).Value = strClassName ActiveCell.Cells(2, 2).Activate Dim c As Collection Set c = lParam Dim indent As Long indent = c(INDENT_KEY) c.Add String(indent * 2, " ") & Hex(hWnd) & " " & strCaption & " " & strClassName, before:=c.Count indent = indent + 1 c.Remove INDENT_KEY c.Add indent, INDENT_KEY Call EnumChildWindows(hWnd, AddressOf EnumChildWindowsProc, ObjPtr(c)) indent = c(INDENT_KEY) - 1 c.Remove INDENT_KEY c.Add indent, INDENT_KEY ActiveCell.Cells(1, 0).Activate End Function Sub hoge() Application.ScreenUpdating = False Dim sht As Worksheet Set sht = ThisWorkbook.Worksheets(1) sht.UsedRange.Clear sht.Activate sht.Range("A1").Activate Dim c As Collection Set c = New Collection c.Add 0, INDENT_KEY Dim ret As Long ret = EnumWindows(AddressOf EnumWindowsProc, ObjPtr(c)) c.Remove INDENT_KEY Set sht = ThisWorkbook.Worksheets(2) sht.UsedRange.Clear sht.Activate sht.Range("A1").Activate Dim o As Variant For Each o In c ActiveCell.Value = o ActiveCell.Cells(2, 1).Activate Next Application.ScreenUpdating = True End Sub