Oracle Forms Question

welburn_sr · Aug 22, 2005

As part of some testing at work, I use the OLE Automation of the Attachmate program to pass key presses and variables using the sendkeys method which then update our Oracle DB. We are moving to an Oracle 9iAS using Oracle Forms 10.
Essentially I am looking to do the same as I have before, ie send keys, mouse clicks (if possible) and variables from an excel spreadsheet into the Oracle Form using VBA. I have done some searching on the internet but haven't been able to find anything. I just can't locate any help on this.
I'm not looking for ODBC as the testing is to actually test the forms not the database.
Any help greatly appreciated,

Cheers,

Mike

BrianB · Aug 23, 2005

This is a big job. A big problem is that when using API calls & Sendkeys etc. it is not possible to step through the code line by line - because the VB Editor is then the active window.

When completed the code will not run 100% correctly all the time due to variations in server speed. There is much tweaking required using Wait statements to get code to stop to allow time for things to happen on screen. However, users preferred to have the code with its problems rather than not.

Here is some code which will contain most, if not all, of what you will need.

Code:

'========================================================================
'- FINAL FINANCE PURCHASE ORDER AUTHORISATION
'- MACRO TO SELECT AN EMAIL AND OPEN WORD DOCUMENT ATTACHMENT
'- THEN CHECK PURCHASE ORDER NUMBERS IN SAP FOR CORRECT AUTHORISATIONS
'- Includes code for SendKeys and Mouse manipulation of SAP screens
'=========================================================================
'- User instructions
'1.OPEN SAP AND OUTLOOK MAIL.
'2.SAP PROGRAM 'ME23' AND PRESS ENTER
'  This gets to SAP screen 'Display Purchase Order : Initial Screen'
'  ... Which should always be the starting point in SAP before running the macro.
'3.RUN THE EXCEL  MACRO          [RUN MACRO] button
'  a.Mail List box : select mail required
'  b.Automatic Extract of any PO numbers in the mail.
'  c.Purchase Order List box :
'    Select Single Purchase Order or Automatic run of all POs in mail.
'    (other options to See Mail - Open a New Mail - Exit Program)
'4.MACRO RETURNS TO 3c. Purchase Order Listbox if processing is not complete.
'  Choose to : Run another PO Number - Open New Mail - or Exit Program


'==============================
'- F1 LOG - VERSION 4
'==============================
'-
Option Explicit
Declare Function FindWindow Lib "user32.dll" _
    Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
'-
Public Declare Function BringWindowToTop Lib "user32.dll" (ByVal hwnd As Long) As Long
'-
Declare Function M_GetActiveWindow Lib "user32" _
    Alias "GetActiveWindow" () As Long
'-
Private Declare Function SetCursorPos Lib "user32" _
    (ByVal x As Long, ByVal y As Long) As Long
'-
Private Declare Function GetWindowRect Lib "user32" _
    (ByVal xHwnd As Long, lpRect As RECT) As Long
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
'-
Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal _
bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
'-
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _
    ByVal dx As Long, ByVal dy As Long, ByVal cbuttons As Long, _
    ByVal dwExtraInfo As Long)
'-
Public xHwnd As Long
Public xHwnd2 As Long
Dim RetVal As Long
Dim lpRect As RECT
Dim L As Long
Dim R As Long
Dim T As Long
Dim B As Long
Dim Across As Long
Dim Down As Long
Dim Xpos As Long
Dim Ypos As Long
'-
Public NewSheet As Boolean
Dim MyData As DataObject
Dim DataSheet As Worksheet
Dim MemoSheet As Worksheet
Dim MouseData As Range
Public ExcelWindowName As String
Public SAP_WindowName As String
Public ToRow As Long
Dim SequenceNo As Integer
Dim c As Integer
Dim c3
Dim c4
Dim c10
Dim x
Dim k
Dim i
Dim n
Dim ws
'-
Dim Contact_Name As String
Public PO_Number As String
Dim PO_Total As Integer
Dim PO_Count As Integer
Dim PO_Automatic As Boolean
Dim PO_List As Object
Dim PO_Index As Integer
Dim PO_Done As String
Dim PO_Completed As Integer
Dim WBS_Element As String
Dim Vendor As String
Dim Order_Value As Double
Dim ReleaseOutstanding As String
Dim Priority As String
Dim Comments As String
'-
Dim AllStatus As String
Dim PartStatus As String
'-
Dim tries As Integer
'-
Private Const VK_LMOUSEUP = &H4
Private Const VK_LMOUSEDOWN = &H2
Private Const VK_KEYUP = &H2
'-
Private Const VK_ESCAPE = &H1B
Private Const VK_SHIFT = &H10
Private Const VK_TAB = &H9      '*
Private Const VK_RETURN = &HD   '*
Private Const VK_CONTROL = &H11 '*
Private Const VK_MENU = &H12    '*
Private Const VK_END = &H23     '*
Private Const VK_HOME = &H24    '*
Private Const VK_SELECT = &H29  '*
Private Const VK_SPACE = &H20
Private Const VK_UP = &H26
Private Const VK_A = &H41
Private Const VK_B = &H42
Private Const VK_C = &H43
Private Const VK_D = &H44
Private Const VK_H = &H48
Private Const VK_I = &H49
Private Const VK_R = &H52
'--
Private Const VK_F3 = &H72
Private Const VK_F5 = &H74
Private Const VK_F7 = &H76
'- Outlook mail
Public RunProg As Boolean
Dim RunMail As Boolean
Dim MailError As Boolean
Dim MailList(500, 4)
Dim MailListItems As Integer
Public MyOlApp As Object
Public MyNamespace As Object
Public MyMailFolder As Object
Public MyName As String
Dim MailBoxName As String
Public MyMailItem As Object
Dim MailSender As String
Dim MailDate As String
Dim MailSubject As String
Dim MailBody As String
Dim MailMoved As Boolean
Dim MyFilePath As String
Dim SelectedMail As Integer
Dim ArchiveFolder As Object
Dim WaitMsg As String
Dim WaitBox As Object
Dim MyMailListBox As Object
Dim ClearMemoSheet As Boolean
'-



'==================================================================================
'- THIS IS THE MAIN ROUTINE THAT RUNS THE OTHERS
'- VERSION 4
'==================================================================================
'-
Sub F1_VERSION_4()
    ExcelWindowName = ThisWorkbook.Name
    Set DataSheet = ActiveSheet
    Set MemoSheet = ThisWorkbook.Worksheets("memosheet")
    Contact_Name = MemoSheet.Range("Contact").Value
    '--
    PO_Total = MemoSheet.Range("POtotal").Value
    If PO_Total = 0 Then get_mail
    '------------------------------------------
    RunProg = True
    While RunProg = True
        '=========================================
        '-- Initialise combobox from memosheet
        '=========================================
        Set PO_List = NameNumberForm.PO_combo
        For c = 0 To PO_Total - 1
           PO_List.AddItem
           PO_List.List(c, 0) = MemoSheet.Cells(c + 2, 1).Value
           PO_List.List(c, 1) = MemoSheet.Cells(c + 2, 2).Value
        Next
        NameNumberForm.ContactBox.Value = MemoSheet.Range("Contact").Value
        PO_List.ListIndex = 0
        '===========================
        AppActivate "Microsoft Excel - " & ExcelWindowName
        Beep
        '====================
        '- MAIN FORM
        '====================
        NameNumberForm.Show
        Select Case NameNumberForm.Tag
            Case "exit"
                Unload NameNumberForm
                MemoSheet.Range("DataRange").ClearContents
                MemoSheet.Range("POrange").ClearContents
                RunProg = False
            Case "NewMail"
                get_mail
            Case "Single"
                PO_Number = PO_List.Value
                PO_Index = PO_List.ListIndex + 1
                If PO_List.List(PO_Index - 1, 1) = "done" Then
                    Beep
                    RetVal = MsgBox("PO Number : " & PO_Number & " already processed." & Chr(13) & "Do you wish to do it again ?", vbYesNo + vbQuestion, "REPEAT PROCESS ?")
                    If RetVal = vbYes Then SAP_process
                Else
                    SAP_process
                End If
            Case "Auto"
                For PO_Index = 1 To PO_Total
                    If MemoSheet.Cells(PO_Index + 1, 2).Value = "" Then
                        PO_Number = MemoSheet.Cells(PO_Index + 1, 1).Value
                        SAP_process
                    End If
                Next
                Beep
                MsgBox (PO_Total & " complete.")
        End Select
    Wend
    Application.StatusBar = False
End Sub
'--- END OF PROGRAM -------------------------------------------------------------------------------
'==================================================================================================

'==============================================
'- SAP PROCESS
'==============================================
Private Sub SAP_process()
    PO_Completed = MemoSheet.Range("PO_Completed").Value
    AllStatus = ""
    get_current_row
    '--
    get_PO
    get_vendor_name
    get_wbs_element
    get_value
    get_release
    get_priority
    reset_program
    '-------------------------------------------
    MemoSheet.Cells(PO_Index + 1, 2).Value = "done"
    If PO_Completed = PO_Total Then
        Beep
        MsgBox ("All complete.")
    Else
        PO_Completed = PO_Completed + 1
        MemoSheet.Range("PO_Completed").Value = PO_Completed
    End If
End Sub
'-- EOP SAP PROCESS ----------------------------------

'==============================
'- SCREEN 1 : PURCHASE ORDER
'==============================
'-
Private Sub get_PO()
    SequenceNo = 1
    SAP_WindowName = "Display Purchase Order : Initial Screen"
    '- window
    xHwnd = FindWindow(CLng(0), "Display Purchase Order : Initial Screen")      ' look for the window
    If xHwnd = 0 Then
        Beep
        MsgBox ("Need to reset SAP.")
        End
    End If
    '=============================================
    '- CONTACT NAME & PO NUMBER
    '=============================================
    DataSheet.Cells(ToRow, 2).Value = Contact_Name
    DataSheet.Cells(ToRow, 3).Value = PO_Number
    '=============================================
    MemoSheet.Range("ActiveWindow").Value = xHwnd
    RetVal = BringWindowToTop(xHwnd)
    '- paste PO number
    Application.SendKeys PO_Number, True   ' insert PO number
    DoEvents
    DELAY1
    '--
End Sub

'==============================
'- SCREEN 2 : VENDOR NAME
'==============================
'-
Private Sub get_vendor_name()
    SequenceNo = 2
   PartStatus = " 2.VENDOR NAME"
   Show_Status
    '- from screen 1
    PressKey (VK_F7)
    DELAY3
    '- new screen
    SAP_WindowName = "Display Purchase Order : Vendor Address"
    '- mouse click
    Across = 300
    Down = 260
    SnapMouse
    '- select & copy name
    Select_Copy_Data
    '- paste to sheet
    Set MyData = New DataObject
    MyData.GetFromClipboard
    x = MyData.GetText(1)
    DataSheet.Cells(ToRow, 7).Value = x
    '-
End Sub

'==============================
'- SCREEN 3 : WBS ELEMENT
'==============================
'-
Private Sub get_wbs_element()
    SequenceNo = 3
   PartStatus = "3.WBS ELEMENT"
   Show_Status
    '-from screen 2
    SAP_WindowName = "Display Purchase Order : Item Overview"
    PressKey (VK_F5)    ' F5 key
    PressKey (VK_TAB)   ' Tab key
    PressKey (VK_SPACE) ' Space
    '- menu
    Call keybd_event(VK_MENU, 0, 0, 0)          ' Alt down
        DoEvents
        PressKey (VK_I)                         ' I down
    Call keybd_event(VK_MENU, 0, VK_KEYUP, 0)   ' Alt up
    DoEvents
    DELAY2
    '-
    PressKey (VK_A)     ' A key
    DELAY3
    '--
    SAP_WindowName = "Account Assignment for item 00001"
    PressKey (VK_UP)    ' Up Arrow
    PressKey (VK_UP)    ' Up arrow
    '-- select & copy
    Select_Copy_Data
    '- paste to sheet
    Set MyData = New DataObject
    MyData.GetFromClipboard
    x = MyData.GetText(1)
    DataSheet.Cells(ToRow, 6).Value = x
End Sub
'==============================
'- SCREEN 4 : VALUE
'==============================
'-
Private Sub get_value()
    SequenceNo = 4
    SAP_WindowName = "Purchase Order Display: Header - Conditions"
   PartStatus = "4.VALUE"
   Show_Status
    '- menu
    PressKey (VK_ESCAPE)
    DELAY2
    Call keybd_event(VK_MENU, 0, 0, 0)          ' Alt down
    DoEvents
    DELAY1
    PressKey (VK_D)                             ' D key
    DoEvents
    DELAY1
    Call keybd_event(VK_MENU, 0, VK_KEYUP, 0)   ' Alt up
    DoEvents
    DELAY1
    PressKey (VK_C)                             ' C key
    DELAY1
    '- mouse copy
'     Across = 520
'     Down = 255
'     SnapMouse
    AppActivate "Microsoft Excel - " & ExcelWindowName
    Beep
    MsgBox ("Please click anywhere in the SAP Value box" & Chr(13) & Chr(13) _
        & "Then return here and press OK.")
    RetVal = BringWindowToTop(xHwnd)
    DELAY2
    '-- select & copy
    Select_Copy_Data
    '- paste to sheet
    Set MyData = New DataObject
    MyData.GetFromClipboard
    DataSheet.Cells(ToRow, 8).Value = MyData.GetText(1)
    '-
End Sub

'==============================
'- SCREEN 5 : RELEASE
'==============================
privte Sub get_release()
    SequenceNo = 5
    SAP_WindowName = "Display Purchase Order : Header data"
   PartStatus = "5.RELEASE"
   Show_Status
    '-- menu
    PressKey (VK_F3)
    DELAY2
    Call keybd_event(VK_MENU, 0, 0, 0)          ' Alt down
    DoEvents
    PressKey (VK_D)           ' D key
    DELAY1
    Call keybd_event(VK_MENU, 0, VK_KEYUP, 0)   ' Alt up
    DoEvents
    DELAY1
    PressKey (VK_R)                             ' R key
    DELAY2
    SAP_WindowName = "Release Strategy Purchase Ord " & PO_Number
    xHwnd2 = FindWindow(CLng(0), SAP_WindowName)      ' look for the window
    '=============================================================
    '- get_release_outstanding
    AppActivate "Microsoft Excel - " & ExcelWindowName
    Beep
    ReleaseForm.Show
    '============================
    SAP_WindowName = "Release Strategy Purchase Ord " & DataSheet.Cells(ToRow, 3).Value
    RetVal = BringWindowToTop(xHwnd2)   'NB. sub window
    '=============================
    ReleaseOutstanding = ReleaseForm.Tag
    If ReleaseOutstanding = "F1" Then
        DataSheet.Cells(ToRow, 10).Value = "YES"
    Else
        DataSheet.Cells(ToRow, 10).Value = "NO"
        DataSheet.Cells(ToRow, 11).Value = ReleaseOutstanding
    End If
    
End Sub
'==============================================
'- SCREEN 6 : PRIORITY BUDGET CLASSIFICATION
'==============================================
Private Sub get_priority()
    SequenceNo = 6
    SAP_WindowName = "Display Purchase Order : Header data"
    PartStatus = "6.PRIORITY"
    Show_Status
    '-- menu
    '- to beginning screen SAP R/3 SYSTEM
    PressKey (VK_ESCAPE)
    Call keybd_event(VK_SHIFT, 0, 0, 0)         ' shift down
        PressKey (VK_F3)                        ' F3 key
        DoEvents
        DELAY1
    Call keybd_event(VK_SHIFT, 0, VK_KEYUP, 0)  ' shift up
    DoEvents
    DELAY3
    '----------------------------------
    '- back to start
    '----------------------------------
    Application.SendKeys "CJ03~", True
    DoEvents
    DELAY2
    '----------------------------------------------
    PressKey (VK_TAB)
    WBS_Element = DataSheet.Cells(ToRow, 5).Value
    Application.SendKeys WBS_Element & "~", True
    DoEvents
    DELAY1
    '----------------------------------------------
    PressKey (VK_TAB)
    PressKey (VK_SPACE)
    Call keybd_event(VK_MENU, 0, 0, 0)          ' Alt down
        PressKey (VK_D)                         ' d key
        DoEvents
        DELAY1
    Call keybd_event(VK_MENU, 0, VK_KEYUP, 0)   ' Alt up
    DoEvents
    PressKey (VK_B)
    DELAY2
    '=========================
    '- PRIORITY CLASSIFICATION
    '=========================
    AppActivate "Microsoft Excel - " & ExcelWindowName
    Beep
    PriorityForm.Show
    Priority = PriorityForm.PriorityTextBox.Value
    DataSheet.Cells(ToRow, 9).Value = Priority
    Comments = PriorityForm.CommentsTextBox.Value
    DataSheet.Cells(ToRow, 12).Value = Comments
    '-
    PriorityForm.PriorityTextBox.Value = ""
    PriorityForm.CommentsTextBox.Value = ""
End Sub

'==============================================
'- SCREEN 7 : RESET SAP TO START SCREEN
'==============================================
Private Sub reset_program()
    SequenceNo = 7
    SAP_WindowName = "Display Project: WBS element Basic Data"
    AllStatus = ""
    PartStatus = "********************* RESETTING SAP SCREEN **********************"
    Show_Status
    '--
    RetVal = BringWindowToTop(xHwnd)
    '-
    Call keybd_event(VK_SHIFT, 0, 0, 0)         ' Shift down
        DoEvents
        PressKey (VK_F3)                        ' F3 key
    Call keybd_event(VK_SHIFT, 0, VK_KEYUP, 0)  ' Shift up
    DoEvents
    DELAY1
    '--
    Call keybd_event(VK_SHIFT, 0, 0, 0)         ' Shift down
        DoEvents
        PressKey (VK_F3)                        ' F3 key
    Call keybd_event(VK_SHIFT, 0, VK_KEYUP, 0)  ' Shift up
    DoEvents
    DELAY1
    '--
    Application.SendKeys "ME23~"
    DoEvents
    DELAY2
End Sub

'==============================
' GET DETAILS FROM MAIL
'==============================
'-
Private Sub get_mail()
'    RunMail = False
'    MemoSheet.Range("RunMail").Value = RunMail
    NewSheet = False
    MemoSheet.Range("DataRange").ClearContents
    MemoSheet.Range("POrange").ClearContents
    '==============
    get_mail_list
    '==============
    '------------------------------------
    '- add mail items to list box
    '------------------------------------
    Set MyMailListBox = MailForm.ListBox1
    'MyMailListBox.ColumnWidths = "60;90;200;0"
    For R = 0 To MailListItems - 1
        MyMailListBox.AddItem
        For c = 0 To 3
            MyMailListBox.List(R, c) = MailList(R + 1, c + 1)
        Next c
    Next R
    Beep
    '-----------------------------------
    MailForm.Show      ' RUN USERFORM
    '-----------------------------------
    '- cancel button clicked
    If RunProg = False Then
        Unload MailForm
        Application.StatusBar = False
        End
    End If
    '--------------------------------
    '- check selection
    RunProg = False
    For i = 0 To MyMailListBox.ListCount - 1
        If MyMailListBox.Selected(i) = True Then
            RunProg = True
        End If
    Next
    If RunProg = False Then
        Beep
        MsgBox ("Nothing selected.")
        Unload MailForm
        Application.StatusBar = False
        End
    End If
    '------------------------------------------------------
    '- get selected mail
    For i = 0 To MyMailListBox.ListCount - 1
        If MyMailListBox.Selected(i) = True Then
            SelectedMail = Val(MyMailListBox.List(i, 3))    ' Mail counter in Inbox
            Set MyMailItem = MyMailFolder.Items(SelectedMail)
            MailDate = Format(DateValue(MyMailItem.creationtime), "dd-mm-yyyy")
            MailSender = MyMailItem.SenderName
            MailSubject = MyMailItem.Subject
            MailBody = MyMailItem.body
            Contact_Name = MailSender
          End If
    Next
    AppActivate "Microsoft Excel - " & ExcelWindowName
    '-------------------------------------------------------
    '- make PO number list in MemoSheet
    '-------------------------------------------------------
    PO_Total = MemoSheet.Range("POtotal").Value
    PO_Total = 0
    ToRow = 2
    For c = 1 To Len(MailBody)
        c3 = Mid(MailBody, c, 3)
        If c3 = "550" Or c3 = "650" Then
            c10 = Mid(MailBody, c, 10)
            MemoSheet.Cells(ToRow, 1).Value = c10
            PO_Total = PO_Total + 1
            ToRow = ToRow + 1
        ElseIf c3 = "55/" Or c3 = "65/" Then
            c10 = "55000" & Mid(MailBody, c + 3, 5)
            MemoSheet.Cells(ToRow, 1).Value = c10
            PO_Total = PO_Total + 1
            ToRow = ToRow + 1
        End If
    Next
    '--
    If PO_Total = 0 Then
        Beep
        MsgBox ("Cannot find PO number")
        MyMailItem.display
        End
    End If
    '===========================================
    '- INITIALISE MEMORY SHEET VARIABLES
    '============================================
    MemoSheet.Range("Contact").Value = Contact_Name
    MemoSheet.Range("Date").Value = MailDate
    MemoSheet.Range("Subject").Value = MailSubject
    '-
    MemoSheet.Range("POtotal").Value = PO_Total
    MemoSheet.Range("PO_Completed").Value = 0
    MemoSheet.Range("automatic").Value = False
    '-
    MemoSheet.Range("MyMailFolder").Value = MyMailFolder
    MemoSheet.Range("SelectedMail").Value = SelectedMail
    '------------------
    PO_Automatic = False
    '-
    '===========================================
    '- CHECK NEW SHEET
    '============================================
    If NewSheet = True Or ActiveSheet.Name = "TEMPLATE" Then
        Sheets("TEMPLATE").Copy Before:=Sheets(1)
        n = 1
        For Each ws In Worksheets
            If Left(ws.Name, 8) = "NewSheet" Then n = n + 1
        Next
        ActiveSheet.Name = "NewSheet" & n
        ActiveSheet.Range("A1").Select
    End If
    Set DataSheet = ThisWorkbook.ActiveSheet
    '------------------------------------------------------------
    Unload MailForm
    Set MyOlApp = Nothing
End Sub
'=========================================
'  GET MAIL LIST : SUBROUTINE
'=========================================
'-
pivate Sub get_mail_list()
    WaitMsg = "PLEASE WAIT - Checking Mail"
    do_waitbox
    mail_setup
    '------------------------------------------------------
    '- mail list for user form
    '------------------------------------------------------
    For i = 1 To MyMailFolder.Items.Count
        Set MyMailItem = MyMailFolder.Items(i)
        MailDate = Format(DateValue(MyMailItem.creationtime), "dd/mm/yyyy")
        MailSender = MyMailItem.SenderName
        MailSubject = MyMailItem.Subject
        MailListItems = MailListItems + 1
        '-
        MailList(i, 1) = MailDate
        MailList(i, 2) = MailSender
        MailList(i, 3) = MailSubject
        MailList(i, 4) = i
    Next
    WaitBox.Delete
End Sub
'-- end of get_mail ----------------------------------------------------------

Private Sub mail_setup()
    '- MAIL SETUP -----------------------------------
    Set MyOlApp = Nothing
    Set MyOlApp = CreateObject("Outlook.Application")
    Set MyNamespace = MyOlApp.GetNamespace("MAPI")
    MyName = MyNamespace.currentuser
    MailBoxName = "Mailbox - " & MyName
    Set MyMailFolder = MyNamespace.folders(MailBoxName).folders("Inbox")
    Set ArchiveFolder = MyNamespace.folders("Personal Folders").folders("F1 Releases").folders("Actioned")
End Sub




'=======================
' FIND LAST ROW
'========================
Private Sub get_current_row()
    ToRow = 4
    While Cells(ToRow, 2).Value <> ""
        ToRow = ToRow + 1
    Wend
End Sub

'=================================
'- API SET CURSOR POSITION
'=================================
Private Sub SnapMouse()
    Dim cbuttons As Long
    Dim dwExtraInfo As Long
    '--
    GetWindowRect xHwnd, lpRect
    L = lpRect.Left
    R = lpRect.Right
    T = lpRect.Top
    B = lpRect.Bottom
    Xpos = L + Across
    Ypos = T + Down
    '-----------------------------------------------
    SetCursorPos Xpos, Ypos
    mouse_event VK_LMOUSEDOWN, 0&, 0&, cbuttons, dwExtraInfo
    mouse_event VK_LMOUSEUP, 0&, 0&, cbuttons, dwExtraInfo
End Sub

'=============================
' API PRESS KEY
'=============================
Private Sub PressKey(k)
    Call keybd_event(k, 0, 0, 0)          ' down
    Call keybd_event(k, 0, VK_KEYUP, 0)   ' up
    DoEvents
    DELAY1
End Sub

'=============================
' API COPY & PASTE
'=============================
Private Sub Select_Copy_Data()
    '-- select
    Call keybd_event(VK_HOME, 0, 0, 0)          ' Home down
    DoEvents
    Call keybd_event(VK_HOME, 0, VK_KEYUP, 0)   ' Home up
    DoEvents
    Call keybd_event(VK_SHIFT, 0, 0, 0)         ' Shift down
        DoEvents
        Call keybd_event(VK_END, 0, 0, 0)       ' End down
        DELAY2
        DoEvents
        Call keybd_event(VK_END, 0, VK_KEYUP, 0) ' End up
        DoEvents
        DELAY1
    Call keybd_event(VK_SHIFT, 0, VK_KEYUP, 0)   ' Shift up
    DoEvents
    DELAY2
    '-- copy
    Call keybd_event(VK_CONTROL, 0, 0, 0)       ' Control down
    DoEvents
    Call keybd_event(VK_C, 0, 0, 0)             ' C down
    DoEvents
    Call keybd_event(VK_C, 0, VK_KEYUP, 0)      ' C up
    DoEvents
    Call keybd_event(VK_CONTROL, 0, VK_KEYUP, 0) ' Control up
    DoEvents
    DELAY1
End Sub

'======================
' PLEASE WAIT BOX
'======================
Private Sub do_waitbox()
    Beep
    Set WaitBox = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 280, 50, 250, 35)
    WaitBox.Fill.ForeColor.SchemeColor = 43
    WaitBox.Line.Weight = 4.5
    With WaitBox.TextFrame
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Characters.Text = WaitMsg
        .Characters.Font.Name = "Times New Roman"
        .Characters.Font.FontStyle = "bold"
        .Characters.Font.Size = 12
        .Characters.Font.ColorIndex = xlAutomatic
    End With
End Sub
'-- end of waitbox -----------------------------------

'============================
' DELETE LINE FROM WORKSHEET
'============================
Private Sub DELETE_LINE()
    Beep
    R = ActiveCell.Row
    If R < 5 Then R = 5
    ActiveSheet.Range("b" & R & ":c" & R).ClearContents
    ActiveSheet.Range("f" & R & ":l" & R).ClearContents
    R = R + 1
    ActiveSheet.Range("B" & R).Select
End Sub


'===========================
'- STATUSBAR MESSAGE
'===========================
Private Sub Show_Status()
    AllStatus = AllStatus & " | " & PartStatus
    Application.StatusBar = AllStatus
End Sub

'===========================
'- DELAYS
'===========================
Private Sub DELAY1()
    Application.Wait Now + TimeValue("00:00:01")
End Sub
Private Sub DELAY2()
    Application.Wait Now + TimeValue("00:00:02")
End Sub
Private Sub DELAY3()
    Application.Wait Now + TimeValue("00:00:03")
End Sub
Private Sub DELAY4()
    Application.Wait Now + TimeValue("00:00:04")
End Sub

welburn_sr · Aug 23, 2005

Thanks for that, I guess that'll be most of my day working out what it all does!

Cheers,

Mike

Oracle Forms Question

welburn_sr

New Member

Excel Facts

BrianB

Well-known Member

welburn_sr

New Member

Similar threads

Forum statistics

Share this page

Oracle Forms Question

welburn_sr

New Member

Excel Facts

BrianB

Well-known Member

welburn_sr

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock