Showing posts with label MS Access. Show all posts
Showing posts with label MS Access. Show all posts

Monday, October 21, 2024

ACCESS VBA openform after closeform code continue

Sub OpenFormAndWait()

    ' Open the form in dialog mode

    DoCmd.OpenForm "YourFormName", WindowMode:=acDialog

    

    ' Code here will execute after the form is closed

    MsgBox "The form has been closed. Continuing with the code..."

End Sub


from copilot help

Thursday, March 21, 2024

VBA set text to clipboard (= ctrl+c)

 


'********* Code Start ************ ' This code was originally written by Terry Kreft. ' It is not to be altered or distributed, ' except as part of an application. ' You are free to use it in any application, ' provided the copyright notice is left unchanged. ' ' Code Courtesy of ' Terry Kreft ' Public Const GHND = &H42 Public Const CF_TEXT = 1 Private Const CF_ANSIONLY = &H400& Private Const CF_APPLY = &H200& Private Const CF_BITMAP = 2 Private Const CF_DIB = 8 Private Const CF_DIF = 5 Private Const CF_DSPBITMAP = &H82 Private Const CF_DSPENHMETAFILE = &H8E Private Const CF_DSPMETAFILEPICT = &H83 Private Const CF_DSPTEXT = &H81 Private Const CF_EFFECTS = &H100& Private Const CF_ENABLEHOOK = &H8& Private Const CF_ENABLETEMPLATE = &H10& Private Const CF_ENABLETEMPLATEHANDLE = &H20& Private Const CF_ENHMETAFILE = 14 Private Const CF_FIXEDPITCHONLY = &H4000& Private Const CF_FORCEFONTEXIST = &H10000 Private Const CF_GDIOBJFIRST = &H300 Private Const CF_GDIOBJLAST = &H3FF Private Const CF_HDROP = 15 Private Const CF_INITTOLOGFONTSTRUCT = &H40& Private Const CF_LIMITSIZE = &H2000& Private Const CF_LOCALE = 16 Private Const CF_MAX = 17 Private Const CF_METAFILEPICT = 3 Private Const CF_NOFACESEL = &H80000 Private Const CF_NOSCRIPTSEL = &H800000 Private Const CF_NOSIMULATIONS = &H1000& Private Const CF_NOSIZESEL = &H200000 Private Const CF_NOSTYLESEL = &H100000 Private Const CF_NOVECTORFONTS = &H800& Private Const CF_NOOEMFONTS = CF_NOVECTORFONTS Private Const CF_NOVERTFONTS = &H1000000 Private Const CF_OEMTEXT = 7 Private Const CF_OWNERDISPLAY = &H80 Private Const CF_PALETTE = 9 Private Const CF_PENDATA = 10 Private Const CF_PRINTERFONTS = &H2 Private Const CF_PRIVATEFIRST = &H200 Private Const CF_PRIVATELAST = &H2FF Private Const CF_RIFF = 11 Private Const CF_SCALABLEONLY = &H20000 Private Const CF_SCREENFONTS = &H1 Private Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS) Private Const CF_SCRIPTSONLY = CF_ANSIONLY Private Const CF_SELECTSCRIPT = &H400000 Private Const CF_SHOWHELP = &H4& Private Const CF_SYLK = 4 Private Const CF_TIFF = 6 Private Const CF_TTONLY = &H40000 Private Const CF_UNICODETEXT = 13 Private Const CF_USESTYLE = &H80& Private Const CF_WAVE = 12 Private Const CF_WYSIWYG = &H8000 Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal _ dwBytes As Long) As Long Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _ As Long Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) _ As Long Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _ ByVal lpString2 As Any) As Long Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" _ (ByVal lpString As String) As Long Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _ As Long Private Declare Function OpenClipboard Lib "user32" (ByVal Hwnd As Long) _ As Long Private Declare Function CloseClipboard Lib "user32" () As Long Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As _ Long) As Long Private Declare Function EmptyClipboard Lib "user32" () As Long Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat _ As Long, ByVal hMem As Long) As Long Function ClipBoard_SetText(strCopyString As String) As Boolean Dim hGlobalMemory As Long Dim lpGlobalMemory As Long Dim hClipMemory As Long ' Allocate moveable global memory. '------------------------------------------- hGlobalMemory = GlobalAlloc(GHND, Len(strCopyString) + 1) ' Lock the block to get a far pointer ' to this memory. lpGlobalMemory = GlobalLock(hGlobalMemory) ' Copy the string to this global memory. lpGlobalMemory = lstrcpy(lpGlobalMemory, strCopyString) ' Unlock the memory and then copy to the clipboard If GlobalUnlock(hGlobalMemory) = 0 Then If OpenClipboard(0&) <> 0 Then Call EmptyClipboard hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory) ClipBoard_SetText = CBool(CloseClipboard) End If End If End Function Function ClipBoard_GetText() As String Dim hClipMemory As Long Dim lpClipMemory As Long Dim strCBText As String Dim RetVal As Long Dim lngSize As Long If OpenClipboard(0&) <> 0 Then ' Obtain the handle to the global memory ' block that is referencing the text. hClipMemory = GetClipboardData(CF_TEXT) If hClipMemory <> 0 Then ' Lock Clipboard memory so we can reference ' the actual data string. lpClipMemory = GlobalLock(hClipMemory) If lpClipMemory <> 0 Then lngSize = GlobalSize(lpClipMemory) strCBText = Space$(lngSize) RetVal = lstrcpy(strCBText, lpClipMemory) RetVal = GlobalUnlock(hClipMemory) ' Peel off the null terminating character. strCBText = left(strCBText, InStr(1, strCBText, Chr$(0), 0) - 1) Else MsgBox "Could not lock memory to copy string from." End If End If Call CloseClipboard End If ClipBoard_GetText = strCBText End Function Function CopyOlePiccy(Piccy As Object) Dim hGlobalMemory As Long, lpGlobalMemory As Long Dim hClipMemory As Long, X As Long ' Allocate moveable global memory. '------------------------------------------- hGlobalMemory = GlobalAlloc(GHND, Len(Piccy) + 1) ' Lock the block to get a far pointer ' to this memory. lpGlobalMemory = GlobalLock(hGlobalMemory) 'Need to copy the object to the memory here lpGlobalMemory = lstrcpy(lpGlobalMemory, Piccy) ' Unlock the memory. If GlobalUnlock(hGlobalMemory) <> 0 Then MsgBox "Could not unlock memory location. Copy aborted." GoTo OutOfHere2 End If ' Open the Clipboard to copy data to. If OpenClipboard(0&) = 0 Then MsgBox "Could not open the Clipboard. Copy aborted." Exit Function End If ' Clear the Clipboard. X = EmptyClipboard() ' Copy the data to the Clipboard. hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory) OutOfHere2: If CloseClipboard() = 0 Then MsgBox "Could not close Clipboard." End If End Function '********* Code End ************

Credit http://access.mvps.org/access/api/api0049.htm

Monday, July 20, 2015

Disable Alt + F4

Set the "Key Preview" property of the form to Yes.

Now use the Form's "On Key Down" event to do what you ask:


Code:
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim intAltDown As Integer
intAltDown = (Shift And acAltMask) > 0

Select Case KeyCode
  Case vbKeyF4
    If intAltDown Then
      KeyCode = 0
      MsgBox "Alt+F4 has beed Disabled.", vbExclamation + vbOKOnly, " Disabled Key"
    End If
End Select
End Sub
HTH
RDH