Blog
Engineering blogs
-
- http://ingenieriaenlared.wordpress.com/
- http://estructurando.net/
- http://www.fierasdelaingenieria.com/
- http://geojuanjo.blogspot.com.es/
- http://enriquemontalar.com/
- http://www.carreteros.org/
- http://infocivil.es/
- http://treneando.com/
- http://manologallegos.blogspot.com.es/
- https://unblogdeingenieria.wordpress.com/otras-web-sobre-ingenieria/
Dealing with coordinates, datums and reference systems
The following formulae can be used to transform geographic coordinates between geodetic datums using three and seven parameter similarity transformations.
These formulas are formally defined in the LINZ standard LINZS25000 (Standard for New Zealand Geodetic Datum 2000), and are summarised in the associated NZGD2000 fact sheet (LINZG25700) and LINZG25703 (Fact Sheet – Datum and Projection Transformations).
This conversion is a three-step process:
-
- Convert geographic coordinates to their Cartesian equivalents
- Apply similarity transformation to Cartesian coordinates
- Convert Cartesian coordinates back to geographic values
Geographic coordinates to Cartesian coordinates
These formulae can be used to convert geographic coordinates, latitude ( Φ ), longitude ( λ ), and height ( h), into Cartesian coordinates (X, Y, Z ):
Where a and f are obtained from the reference ellipsoid used for the respective geodetic datum and the h is the height of the computation point or approximated as zero
Three parameter transformation
The three parameter transformation is implemented using:
Seven parameter transformation
The Helmert seven parameter similarity transformation is implemented using: Note: the rotation parameters ( R ) must be converted from arc-seconds to radians before being used in this equation.
Note: this is a simplified version of the Helmert formulae that applies for small rotation angles. This is the official formulae to use for the NZGD49-NZGD2000 seven parameter transformation.
Cartesian coordinates to geographic coordinates
These formulas can be used to convert Cartesian coordinates ( X, Y, Z ) into geographic coordinates latitude ( Φ ), longitude ( λ ), and height ( h ). Where a and f are obtained from the reference ellipsoid used for the respective geodetic datum: Note: because NZGD1949 is a horizontal datum the height resulting from the transformation will not be in terms of the output datum, the equation is shown here for completeness.
For most conversions, Transformation Parameters can be found in the NIMA technical report “Department of Defense World Geodetic System 1984” (TR 8350.2) NSN: 7643-01-402-0347. Here is a little visual explanation on what is going on with this operations. There is a lot of more information in this document, and also, on this other one.VBA Excel as ActiveWindow Screenshot recorder
#If VBA7 Then Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) #Else Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) #End If Private Const VK_SNAPSHOT = &H2C Private Const VK_MENU = &H12 Private Const KEYEVENTF_KEYUP = &H2 Private Sub sPrintScreen() ' To capture the screen keybd_event VK_SNAPSHOT, 1, 0, 0 End Sub Private Sub sAltPrintScreen() ' To capture the active window Application.Wait VBA.Now() + TimeSerial(0, 0, 5) keybd_event VK_MENU, 0, 0, 0 keybd_event VK_SNAPSHOT, 0, 0, 0 keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0 keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0 Application.Wait VBA.Now() + TimeSerial(0, 0, 1) ' Add a new worksheet to paste image Dim oXlWsh As Excel.Worksheet Dim oXlShp As Excel.Shape Dim sgLeft As Single Dim sgTop As Single Dim sgWidth As Single Dim sgHeight As Single Dim oCht As Excel.Chart Dim oChtObj As Excel.ChartObject Set oXlWsh = ThisWorkbook.Worksheets.Add 'ActiveSheet With oXlWsh '.Name = ... .Range("A1").Select .Paste ' Save image to file Set oXlShp = .Shapes(.Shapes.Count) With oXlShp ' Copy the picture .Copy '.CopyPicture '' To Resize '.Height = 600 '.Width = 800 '' To Position It: use the shape's TopLeftCell property. '' To Crop It: use the shp.PictureFormat.Crop (and/or CropLeft, CropTop, CropBottom, CropRight) '' if you need to fine-tune what part of the screenshot is needed. '' For instance, this crops the pasted screenshot to 800x600: 'sgHeight = -(600 - .Height) 'sgWidth = -(800 - .Width) '.LockAspectRatio = False '.PictureFormat.CropRight = sgWidth '.PictureFormat.CropBottom = sgHeight ' Save image 'Set oCht = ThisWorkbook.Charts.Add 'oCht.Location Where:=xlLocationAsObject, Name:=.Name Set oChtObj = oXlWsh.ChartObjects.Add(0, 0, .Width, .Height) With oChtObj .Border.LineStyle = 0 .Left = oXlShp.Left .Width = oXlShp.Width .Top = oXlShp.Top .Height = oXlShp.Height 'To save a range: oRng.CopyPicture xlScreen, xlPicture 'or xlPicture --> xlBitmap With .Chart .Paste .Export Filename:=VBA.Environ$("UserProfile") & "\Documents\SavedRange.jpg", FilterName:="JPG" End With DoEvents .Delete ' get rid of the chart End With '.Delete ' get rid of the image End With ' Other options to save the JPG 'https://www.tek-tips.com/viewthread.cfm?qid=1764114 'http://www.mvps.org/emorcillo/en/code/vb6/index.shtml ' Delete worksheet 'Application.DisplayAlerts = False '.Delete 'Application.DisplayAlerts = True End With End SubFrom there on I can, for example, get the controls in that window (following the idea in this enlightning post from Xristos Samaras’s MyEngineeringWorld).
Option Explicit 'Declaring the necessary API functions for both 64 and 32 bit applications. #If VBA7 And Win64 Then 'For 64 bit applications. 'Performs an operation on a specified file. Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr 'Retrieves a handle to the top-level window whose class name and window name match the specified strings. 'This function does not search child windows. This function does not perform a case-sensitive search. Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr 'Retrieves a handle to a window whose class name and window name match the specified strings. 'The function searches child windows, beginning with the one following the specified child window. 'This function does not perform a case-sensitive search. Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr 'Sends the specified message to a window or windows. The SendMessage function calls the window procedure 'for the specified window and does not parentWindowurn until the window procedure has processed the message. Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr 'Places (posts) a message in the message queue associated with the thread that created the specified 'window and parentWindowurns without waiting for the thread to process the message. Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long Private Declare PtrSafe Function GetForegroundWindow Lib "user32.dll" () As LongPtr Private Declare PtrSafe Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As LongPtr) As LongPtr Private Declare PtrSafe Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hWnd As LongPtr) As LongPtr Private Declare PtrSafe Function GetClassName Lib "USER32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As Long Private Declare PtrSafe Function EnumChildWindows Lib "user32.dll" (ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long Private Declare PtrSafe Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Boolean Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As LongPtr 'Private Declare PtrSafe Function GetTopWindow Lib "user32.dll" (ByVal hWnd As LongPtr) As LongPtr 'Private Declare PtrSafe Function GetNextWindow Lib "user32.dll" Alias "GetWindow" (ByVal hWnd As LongPtr, ByVal wFlag As LongPtr) As LongPtr 'Private Declare PtrSafe Function IsWindowVisible Lib "user32.dll" (ByVal hWnd As LongPtr) As LongPtr #Else 'For 32 bit applications. 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 Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetForegroundWindow Lib "user32" () As Long Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function EnumChildWindows Lib "user32.dll" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Private Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long #End If Private Const ERROR_INVALID_WINDOW_HANDLE As Long = 1400 Private Const ERROR_INVALID_WINDOW_HANDLE_DESCR As String = "Invalid window handle." Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) ' Windows API Constants --> https://doc.pcsoft.fr/en-US/?6510001&verdisp=160 & https://www.magnumdb.com/ Private Const SW_HIDE As Long = 0 Private Const SW_SHOWNORMAL As Long = 1 Private Const SW_SHOWMAXIMIZED As Long = 3 Private Const SW_SHOWMINIMIZED As Long = 2 Private Const VK_RETURN As Long = &HD Private Const WM_SETTEXT As Long = &HC Private Const WM_KEYDOWN As Long = &H100 Private Const WM_KEYUP As Long = &H101 Private Const WM_LBUTTONDOWN As Long = 513 Private Const WM_LBUTTONUP As Long = 514 Private Const WM_LBUTTONDBLCLK As Long = 515 Private Const WM_RBUTTONDOWN As Long = 516 Private Const WM_RBUTTONUP As Long = 517 Private Const WM_RBUTTONDBLCLK As Long = 518 Private Const WM_MBUTTONDOWN As Long = 519 Private Const WM_MBUTTONUP As Long = 520 Private Const WM_MBUTTONDBLCLK As Long = 521 Private Const WS_TABSTOP As Long = 65536 Private Const WM_CLOSE As Long = &H10 Private Const BM_CLICK As Long = &HF5 #If VBA7 And Win64 Then Private hWnd As LongPtr Private CtrlHandle As LongPtr #Else Private hWnd As Long Private CtrlHandle As Long #End If 'Used a user defined type here rather than Enum so that it works on 97 Private Type winEnum winHandle As Integer winClass As Integer winTitle As Integer winHandleClass As Integer winHandleTitle As Integer winHandleClassTitle As Integer End Type Private winOutputType As winEnum Private x As Integer Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type #If VBA7 And Win64 Then Private Type tHandle hWnd As LongPtr Name As String ClassName As String End Type #Else Private Type tHandle hWnd As Long Name As String ClassName As String End Type #End If Private aChild() As tHandle Private winNum As Long #If VBA7 And Win64 Then Private Sub Test() ' You can't call this on a button click, because then your window will be the foreground window. ' Add a timer/wait ' Run the procedure, click another window within 5 seconds. Dim hWnd As LongPtr Dim strTitle As String Dim strClassName As String Dim lgClassNameLength As LongPtr Dim lgRetVal As Long MsgBox "Go activate the Window you want to Spy" Application.Wait VBA.Now() + TimeSerial(0, 0, 5) ' If no handle, get active window If hWnd = 0 Then hWnd = hWnd = GetForegroundWindow() strTitle = fWindowTitle(hWnd) strClassName = fWindowClassName(hWnd) ''https://stackoverflow.com/questions/6310731/window-click-ok-button-by-code Erase aChild(): winNum = 0 lgRetVal = EnumChildWindows(hWnd, AddressOf EnumChildProc, 0) Stop ' For lgChild = LBound(aChild) To UBound(aChild) ' Next lgChild Stop ' ' the Button's Caption is "Open" and it is a "Button". ' CtrlHandle = FindWindowEx(hWnd, 0, "Button", "&Open") ' ' send Click to the button(CtrlHandle). ' lgRetVal = SendMessage(CtrlHandle, BM_CLICK, 0, 0) ' 'Fill with text the TextBox. ' lgRetVal = SendMessage(CtrlHandle, WM_SETTEXT, 0&, ByVal strText) ' 'Press the OK button (it is the default action, so no need to find the handle of the button). ' lgRetVal = PostMessage(CtrlHandle, WM_KEYDOWN, VK_RETURN, 0) End Sub Private Function fWindowClassName(ByVal hWnd As LongPrt) As String Dim strClassName As String Dim lgClassNameLength As LongPtr Dim lgRetVal As Long strClassName = String$(100, Chr$(0)) lgRetVal = GetClassName(hWnd, strClassName, 100) fWindowClassName = VBA.Mid$(strClassName, 1, VBA.InStr(1, strClassName, Chr$(0)) - 1) End Function Private Function fWindowTitle(ByVal hWnd As LongPtr) As String Dim strTitle As String ' Dim lgBufferLen As Long ' Dim wintext As String ' window title text length and buffer ' Dim lgRetVal As Long ' return value ' Dim strBuffer As String ' ' lgBufferLen = GetWindowTextLength(hWnd) + 1 ' get length of title bar text ' strBuffer = VBA.Space$(lgBufferLen) ' make room in the buffer ' lgRetVal = GetWindowText(hWnd, strBuffer, lgBufferLen) ' fWindowTitle = VBA.Left$(strBuffer, lgBufferLen - 1) ' display title bar text of enumerated window ' If not handle, get the active window If hWnd = 0 Then hWnd = GetForegroundWindow() ' get the title of the active window strTitle = VBA.String(GetWindowTextLength(hWnd) + 1, VBA.Chr$(0)) ' Make the buffer GetWindowText hWnd, strTitle, Len(strTitle) + 1 fWindowTitle = VBA.Mid$(strTitle, 1, VBA.InStr(1, strTitle, Chr$(0)) - 1) End Function Private Function EnumChildProc(ByVal hWnd As LongPtr, _ ByVal lParam As LongPtr) As Long Dim lgRetVal As Long winNum = winNum + 1 ReDim Preserve aChild(1 To winNum) With aChild(winNum) .ClassName = fWindowClassName(hWnd) .Name = fWindowTitle(hWnd) .hWnd = hWnd '.hWnd = FindWindow(.ClassName, .Name) 'lgRetVal = FindWindowEx(hWnd, 0, .ClassName, .Name) 'lgRetVal = FindWindowEx(hWnd, .hWnd, vbNullString, vbNullString) 'lgRetVal = FindWindowEx(hWnd, 0&, vbNullString, vbNullString) End With EnumChildProc = 1 ' nonzero return value means continue enumeration End Function Private Function fWindowRec(ByVal hWnd As LongPtr, _ ByRef Top As Long, _ ByRef Left As Long, _ ByRef Right As Long, _ ByRef Bottom As Long, _ ByRef Width As Long, _ ByRef Height As Long) As Boolean ' Get left, right, top, and bottom positions of a window in pixels. Dim rectWindow As RECT ' Pass in window handle and empty the data structure. ' If function returns 0, an error occurred. If GetWindowRect(hWnd, rectWindow) = 0 Then ' Check LastDLLError and display a dialog box if the error ' occurred because an invalid handle was passed. If Err.LastDllError = ERROR_INVALID_WINDOW_HANDLE Then fWindowRec = False 'MsgBox ERROR_INVALID_WINDOW_HANDLE_DESCR, Title:="Error!" End If Else With rectWindow Bottom = .Bottom Left = .Left Right = .Right Top = .Top Width = .Right - .Left Height = .Bottom - .Top End With fWindowRec = True End If End Function #Else Private Sub Test() ' You can't call this on a button click, because then your window will be the foreground window. ' Add a timer/wait ' Run the procedure, click another window within 5 seconds. Dim hWnd As Long Dim strTitle As String Dim strClassName As String Dim lgClassNameLength As Long Dim lgRetVal As Long Dim lgChild As Long Dim strText As String MsgBox "Go activate the Window you want to Spy" Application.Wait VBA.Now() + TimeSerial(0, 0, 5) hWnd = GetForegroundWindow() strTitle = fWindowTitle(hWnd) strClassName = fWindowClassName(hWnd) ''https://stackoverflow.com/questions/6310731/window-click-ok-button-by-code Erase aChild(): winNum = 0 lgRetVal = EnumChildWindows(hWnd, AddressOf EnumChildProc, 0) Stop ' For lgChild = LBound(aChild) To UBound(aChild) ' Next lgChild Stop ' ' the Button's Caption is "Open" and it is a "Button". ' CtrlHandle = FindWindowEx(hWnd, 0, "Button", "&Open") ' ' send Click to the button(CtrlHandle). ' lgRetVal = SendMessage(CtrlHandle, BM_CLICK, 0, 0) ' 'Fill with text the TextBox. ' lgRetVal = SendMessage(CtrlHandle, WM_SETTEXT, 0&, ByVal strText) ' 'Press the OK button (it is the default action, so no need to find the handle of the button). ' lgRetVal = PostMessage(CtrlHandle, WM_KEYDOWN, VK_RETURN, 0) End Sub Private Function fWindowClassName(ByVal hWnd As Long) As String Dim strClassName As String Dim lgClassNameLength As Long Dim lgRetVal As Long strClassName = String$(100, Chr$(0)) lgRetVal = GetClassName(hWnd, strClassName, 100) fWindowClassName = VBA.Mid$(strClassName, 1, VBA.InStr(1, strClassName, Chr$(0)) - 1) End Function Private Function fWindowTitle(ByVal hWnd As Long) As String Dim strTitle As String ' Dim lgBufferLen As Long ' Dim wintext As String ' window title text length and buffer ' Dim lgRetVal As Long ' return value ' Dim strBuffer As String ' ' lgBufferLen = GetWindowTextLength(hWnd) + 1 ' get length of title bar text ' strBuffer = VBA.Space$(lgBufferLen) ' make room in the buffer ' lgRetVal = GetWindowText(hWnd, strBuffer, lgBufferLen) ' fWindowTitle = VBA.Left$(strBuffer, lgBufferLen - 1) ' display title bar text of enumerated window ' If not handle, get the active window If hWnd = 0 Then hWnd = GetForegroundWindow() ' get the title of the active window strTitle = VBA.String(GetWindowTextLength(hWnd) + 1, VBA.Chr$(0)) ' Make the buffer GetWindowText hWnd, strTitle, Len(strTitle) + 1 fWindowTitle = VBA.Mid$(strTitle, 1, VBA.InStr(1, strTitle, Chr$(0)) - 1) End Function Private Function EnumChildProc(ByVal hWnd As Long, _ ByVal lParam As Long) As Long Dim lgRetVal As Long winNum = winNum + 1 ReDim Preserve aChild(1 To winNum) With aChild(winNum) .ClassName = fWindowClassName(hWnd) .Name = fWindowTitle(hWnd) .hWnd = hWnd '.hWnd = FindWindow(.ClassName, .Name) 'lgRetVal = FindWindowEx(hWnd, 0, .ClassName, .Name) 'lgRetVal = FindWindowEx(hWnd, .hWnd, vbNullString, vbNullString) 'lgRetVal = FindWindowEx(hWnd, 0&, vbNullString, vbNullString) End With EnumChildProc = 1 ' nonzero return value means continue enumeration End Function Private Function fWindowRec(ByVal hWnd As Long, _ ByRef Top As Long, _ ByRef Left As Long, _ ByRef Right As Long, _ ByRef Bottom As Long, _ ByRef Width As Long, _ ByRef Height As Long) As Boolean ' Get left, right, top, and bottom positions of a window in pixels. Dim rectWindow As RECT ' Pass in window handle and empty the data structure. ' If function returns 0, an error occurred. If GetWindowRect(hWnd, rectWindow) = 0 Then ' Check LastDLLError and display a dialog box if the error ' occurred because an invalid handle was passed. If Err.LastDllError = ERROR_INVALID_WINDOW_HANDLE Then fWindowRec = False 'MsgBox ERROR_INVALID_WINDOW_HANDLE_DESCR, Title:="Error!" End If Else With rectWindow Bottom = .Bottom Left = .Left Right = .Right Top = .Top Width = .Right - .Left Height = .Bottom - .Top End With fWindowRec = True End If End Function #End IfFollowing is another piece of code that did not came to much use, as I could not guess what was the intention of the code -I did really not put too much attention on the thing-. It’s filling the worksheet with names/properties, but barelly understand anything. Seems it getting all the windows in the operating system, and start a loop that seems to not have an end… But looks promissing enough to rip some code apart, starting from the winOutputType.
Public Sub GetWindowInfo() MsgBox "Go activate the Window you want to Spy" Application.Wait Now() + TimeSerial(0, 0, 5) With winOutputType .winHandle = 0 .winClass = 1 .winTitle = 2 .winHandleClass = 3 .winHandleTitle = 4 .winHandleClassTitle = 5 sGetWinInfo 0&, 0, .winHandleClassTitle End With End Sub #If VBA7 And Win64 Then Private Sub sGetWinInfo(ByRef hParent As LongPtr, _ ByRef intOffset As Integer, _ ByRef OutputType As Integer) ' Recursively obtain window handles, classes and text given a parent window to search ' Written by Mark Rowlinson ' www.markrowlinson.co.uk - The Programming Emporium Dim hWnd As Long Dim lngRet As Long Dim y As Integer Dim strText As String hWnd = FindWindowEx(hParent, 0&, vbNullString, vbNullString) While hWnd <> 0 Select Case OutputType Case winOutputType.winClass strText = String$(100, Chr$(0)) lngRet = GetClassName(hWnd, strText, 100) Range("a1").Offset(x, intOffset) = Left$(strText, lngRet) Case winOutputType.winHandle Range("a1").Offset(x, intOffset) = hWnd Case winOutputType.winTitle strText = String$(100, Chr$(0)) lngRet = GetWindowText(hWnd, strText, 100) If lngRet > 0 Then Range("a1").Offset(x, intOffset) = Left$(strText, lngRet) Else Range("a1").Offset(x, intOffset) = "N/A" End If Case winOutputType.winHandleClass Range("a1").Offset(x, intOffset) = hWnd strText = String$(100, Chr$(0)) lngRet = GetClassName(hWnd, strText, 100) Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet) Case winOutputType.winHandleTitle Range("a1").Offset(x, intOffset) = hWnd strText = String$(100, Chr$(0)) lngRet = GetWindowText(hWnd, strText, 100) If lngRet > 0 Then Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet) Else Range("a1").Offset(x, intOffset + 1) = "N/A" End If Case winOutputType.winHandleClassTitle Range("a1").Offset(x, intOffset) = hWnd strText = String$(100, Chr$(0)) lngRet = GetClassName(hWnd, strText, 100) Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet) strText = String$(100, Chr$(0)) lngRet = GetWindowText(hWnd, strText, 100) If lngRet > 0 Then Range("a1").Offset(x, intOffset + 2) = Left$(strText, lngRet) Else Range("a1").Offset(x, intOffset + 2) = "N/A" End If End Select ' check for children y = x Select Case OutputType Case Is > 4 GetWinInfo hWnd, intOffset + 3, OutputType Case Is > 2 GetWinInfo hWnd, intOffset + 2, OutputType Case Else GetWinInfo hWnd, intOffset + 1, OutputType End Select ' increment by 1 row if no children found If y = x Then x = x + 1 ' now get next window hWnd = FindWindowEx(hParent, hWnd, vbNullString, vbNullString) Wend End Sub #Else Private Sub sGetWinInfo(ByRef hParent As Long, _ ByRef intOffset As Integer, _ ByRef OutputType As Integer) ' Recursively obtain window handles, classes and text given a parent window to search ' Written by Mark Rowlinson ' www.markrowlinson.co.uk - The Programming Emporium Dim hWnd As Long Dim lngRet As Long Dim y As Integer Dim strText As String hWnd = FindWindowEx(hParent, 0&, vbNullString, vbNullString) While hWnd <> 0 Select Case OutputType Case winOutputType.winClass strText = String$(100, Chr$(0)) lngRet = GetClassName(hWnd, strText, 100) Range("a1").Offset(x, intOffset) = Left$(strText, lngRet) Case winOutputType.winHandle Range("a1").Offset(x, intOffset) = hWnd Case winOutputType.winTitle strText = String$(100, Chr$(0)) lngRet = GetWindowText(hWnd, strText, 100) If lngRet > 0 Then Range("a1").Offset(x, intOffset) = Left$(strText, lngRet) Else Range("a1").Offset(x, intOffset) = "N/A" End If Case winOutputType.winHandleClass Range("a1").Offset(x, intOffset) = hWnd strText = String$(100, Chr$(0)) lngRet = GetClassName(hWnd, strText, 100) Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet) Case winOutputType.winHandleTitle Range("a1").Offset(x, intOffset) = hWnd strText = String$(100, Chr$(0)) lngRet = GetWindowText(hWnd, strText, 100) If lngRet > 0 Then Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet) Else Range("a1").Offset(x, intOffset + 1) = "N/A" End If Case winOutputType.winHandleClassTitle Range("a1").Offset(x, intOffset) = hWnd strText = String$(100, Chr$(0)) lngRet = GetClassName(hWnd, strText, 100) Range("a1").Offset(x, intOffset + 1) = Left$(strText, lngRet) strText = String$(100, Chr$(0)) lngRet = GetWindowText(hWnd, strText, 100) If lngRet > 0 Then Range("a1").Offset(x, intOffset + 2) = Left$(strText, lngRet) Else Range("a1").Offset(x, intOffset + 2) = "N/A" End If End Select ' check for children y = x Select Case OutputType Case Is > 4 sGetWinInfo hWnd, intOffset + 3, OutputType Case Is > 2 sGetWinInfo hWnd, intOffset + 2, OutputType Case Else sGetWinInfo hWnd, intOffset + 1, OutputType End Select ' increment by 1 row if no children found If y = x Then x = x + 1 ' now get next window hWnd = FindWindowEx(hParent, hWnd, vbNullString, vbNullString) Wend End Sub #End IfNext steps in development should be get the captured image inside a picture control on a new UserForm, and once all the controls are identified and located by position, recreate the original UserForm, so the GUI is cloned in no time, with -depending on the original developer effort on tidyness- probably right names (instead of CommandButton1, ListBox1,…, you know), and all the labels filled with text. The internal code is where you as a developer should put your best to emulate the original code… but that is another history.
VBA Excel set columns width/rows height in millimeters
Option Explicit Sub ChangeWidthAndHeight() SetColumnWidthMM 1, 10 SetRowHeightMM 1, 10 End Sub Private Sub SetRowHeightMM(ByVal RowNo As Long, _ ByVal mmHeight As Integer) ' changes the Row Height to mm Height With ActiveSheet If RowNo < 1 Or RowNo > .Rows.Count Then Exit Sub End With With Application .ScreenUpdating = False ActiveSheet.Rows(RowNo).RowHeight = .CentimetersToPoints(mmHeight / 10) .ScreenUpdating = True End With End Sub Private Sub SetColumnWidthMM(ByVal ColNo As Long, _ ByVal mmWidth As Integer) ' changes the column width to mm Width ' Column widths are not really measured in any "unit" as such. ' Instead, the number refers to the number of characters which can be displayed in the column. ' For variable width fonts such as Arial, the "0" character is used. ' In VBA, the ColumnWidth property uses this measure of width, and the Width property uses Points. ' 1 inch = 72 points ' 1 pointH = 1/72 inches. ' 1 pointH = 0.0353 centimeters (or .353 millimetre) ' 1 pointH = ... x pixels Dim w As Single Dim wSize As Single With ActiveSheet If ColNo < 1 Or ColNo > .Columns.Count Then Exit Sub End With Application.ScreenUpdating = False w = Application.CentimetersToPoints(mmWidth / 10) With ActiveSheet wSize = (.Columns(ColNo + 1).Left - .Columns(ColNo).Left) ' First approximation: With .Columns(ColNo) .ColumnWidth = .ColumnWidth * (w / wSize) End With While .Columns(ColNo + 1).Left - .Columns(ColNo).Left - 0.1 > w '.Columns(ColNo).ColumnWidth = .Columns(ColNo).ColumnWidth - wMove With .Columns(ColNo) 'Debug.Print .ColumnWidth .ColumnWidth = .ColumnWidth - 0.1 End With Wend While .Columns(ColNo + 1).Left - .Columns(ColNo).Left + 0.1 < w With .Columns(ColNo) 'Debug.Print .ColumnWidth .ColumnWidth = .ColumnWidth + 0.1 End With Wend End With Application.ScreenUpdating = True End Sub
GUID on VBA
= CONCATENATE(DEC2HEX(RANDBETWEEN(0,4294967295),8),"-",DEC2HEX(RANDBETWEEN(0,6553??5),4),"-",DEC2HEX(RANDBETWEEN(16384,20479),4),"-",DEC2HEX(RANDBETWEEN(32768,49151??),4),"-",DEC2HEX(RANDBETWEEN(0,65535),4),DEC2HEX(RANDBETWEEN(0,4294967295),8))To get a more consistent method, we can rely on VBA. Here is the code:
' No VT_GUID available so must declare type GUID Private Type GUID_TYPE Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type #If VBA7 Then Private Declare PtrSafe Function CoCreateGuid Lib "ole32.dll" (Guid As GUID_TYPE) As LongPtr Private Declare PtrSafe Function StringFromGUID2 Lib "ole32.dll" (Guid As GUID_TYPE, ByVal lpStrGuid As LongPtr, ByVal cbMax As Long) As LongPtr Public Function GenerateGUID() As String Dim Guid As GUID_TYPE Dim strGuid As String Dim retValue As Long 'Ptr Const guidLength As Long = 39 'registry GUID format with null terminator {xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx} retValue = CoCreateGuid(Guid) If retValue = 0 Then strGuid = String$(guidLength, vbNullChar) retValue = StringFromGUID2(Guid, StrPtr(strGuid), guidLength) If retValue = guidLength Then ' valid GUID as a string GenerateGUID = strGuid End If End If End Function #Else Private Declare Function CoCreateGuid Lib "ole32" (ByRef Guid As Byte) As Long Public Function GenerateGUID() As String Dim ID(0 To 15) As Byte Dim N As Long Dim Guid As String Dim Res As Long Res = CoCreateGuid(ID(0)) For N = 0 To 15 Guid = Guid & IIf(ID(N) < 16, "0", "") & Hex$(ID(N)) If Len(Guid) = 8 Or Len(Guid) = 13 Or Len(Guid) = 18 Or Len(Guid) = 23 Then Guid = Guid & "-" End If Next N GenerateGUID = Guid End Function 'Private Declare Function CoCreateGuid_2 Lib "ole32" (ByRef Guid As GUID_TYPE) As Long 'Public Function NewGUID() As String ''(c) 2000 Gus Molina '' Not working! ' ' Dim udtGUID As GUID_TYPE ' ' If (CoCreateGuid_2(udtGUID) = 0) Then ' GetGUID = _ String(8 - Len(Hex$(udtGUID.Data1)), "0") & Hex$(udtGUID.Data1) & _ String(4 - Len(Hex$(udtGUID.Data2)), "0") & Hex$(udtGUID.Data2) & _ String(4 - Len(Hex$(udtGUID.Data3)), "0") & Hex$(udtGUID.Data3) & _ IIf((udtGUID.Data4(0) < &H10), "0", "") & Hex$(udtGUID.Data4(0)) & _ IIf((udtGUID.Data4(1) < &H10), "0", "") & Hex$(udtGUID.Data4(1)) & _ IIf((udtGUID.Data4(2) < &H10), "0", "") & Hex$(udtGUID.Data4(2)) & _ IIf((udtGUID.Data4(3) < &H10), "0", "") & Hex$(udtGUID.Data4(3)) & _ IIf((udtGUID.Data4(4) < &H10), "0", "") & Hex$(udtGUID.Data4(4)) & _ IIf((udtGUID.Data4(5) < &H10), "0", "") & Hex$(udtGUID.Data4(5)) & _ IIf((udtGUID.Data4(6) < &H10), "0", "") & Hex$(udtGUID.Data4(6)) & _ IIf((udtGUID.Data4(7) < &H10), "0", "") & Hex$(udtGUID.Data4(7)) ' End If 'End Function #End If Public Sub sGenerateGUID() MsgBox GenerateGUID ' NewGUID End Sub
Revit VB.Net programming
Get selection formatting
Public Sub sFormatGet() Call fFormatGet(Selection) End Sub Public Function fRangeR1C1(ByVal oXlRng As Excel.Range, _ Optional ByVal oXlRef As Excel.Range = Nothing) As String Dim lgC As Long Dim lgR As Long Dim strRngR1C1 As String If oXlRef Is Nothing Then Set oXlRef = ActiveSheet.Cells(1, 1) End If lgR = oXlRng.Row lgC = oXlRng.Column fRangeR1C1 = strRngR1C1 End Function Public Function fFormatGet(ByRef oXlRng As Excel.Range, _ Optional ByVal ReferenceStyle As XlReferenceStyle = xlA1) As Boolean If oXlRng Is Nothing Then Set oXlRng = Selection.Cells End If Dim oXlCell As Excel.Range Dim lgBorder As Long Dim iFileOut As Integer Dim bFormat As Boolean Dim bRange As Boolean Dim strRange As String Close iFileOut = VBA.FreeFile() Open VBA.Environ$("UserProfile") & "\Documents\" & "#Format.bas" For Output As #iFileOut Print #iFileOut, "Private Sub sFormatSet(ByVal xlWsh As Excel.Worksheet)" Print #iFileOut, " 'Dim oXlCell As Excel.Range" Print #iFileOut, "" Print #iFileOut, " With xlWsh" For Each oXlCell In oXlRng.Cells bFormat = False bRange = False If oXlCell.MergeCells Then ' only if cell is the left-top most cell in merge area,... If oXlCell.MergeArea.Cells(1, 1).Address = oXlCell.Address Then bFormat = True oXlCell.MergeArea.Merge bRange = True strRange = ".Range(""" & oXlCell.MergeArea.Address & """)" 'If ReferenceStyle = xlA1 Then ' strRange = .Formula 'Else ' strRange = fRangeR1C1(oXlCell.MergeArea) 'End If End If Else bFormat = True strRange = ".Cells(" & oXlCell.Row & ", " & oXlCell.Column & ")" 'If ReferenceStyle = xlA1 Then ' strRange = .Formula 'Else ' strRange = fRangeR1C1(oXlCell) 'End If End If If bFormat Then Print #iFileOut, " With " & strRange Print #iFileOut, " .Merge" If oXlCell.Formula <> vbNullString Then 'If ReferenceStyle = xlA1 Then Print #iFileOut, " .Formula = " & VBA.Replace(oXlCell.Formula, """", """""") 'Else ' Print #iFileOut, " .Formula = " & VBA.Replace(oXlCell.FormulaR1C1, """", """""") 'End If End If With oXlCell If .IndentLevel <> 0 Then Print #iFileOut, " .IndentLevel = " & .IndentLevel End If With .Font Print #iFileOut, " With .Font" Print #iFileOut, " .Name = """ & .Name & """" Print #iFileOut, " .Color = " & .Color Print #iFileOut, " .Size = " & .Size If .Bold Then Print #iFileOut, " .Bold = " & .Bold If .Italic Then Print #iFileOut, " .Italic = " & .Italic If .Underline <> xlNone Then Print #iFileOut, " .Underline = " & VBA.CBool(.Underline) If .Strikethrough Then Print #iFileOut, " .Strikethrough = " & VBA.CBool(.Strikethrough) If .Subscript Then Print #iFileOut, " .Subscript = " & VBA.CBool(.Subscript) If .Superscript Then Print #iFileOut, " .Superscript = " & VBA.CBool(.Superscript) Print #iFileOut, " End With" End With If .Hyperlinks.Count > 0 Then With .Hyperlinks(1) Print #iFileOut, " .Hyperlinks.Add(" & _ " Anchor:=" & oXlCell & ", " & _ VBA.IIf(.Address = vbNullString, "", " Address:=" & .Address & ", ") & _ VBA.IIf(.SubAddress = vbNullString, "", " SubAddress:=" & .SubAddress & ", ") & _ VBA.IIf(.ScreenTip = vbNullString, "", " ScreenTip:=" & .ScreenTip & ", ") & _ VBA.IIf(.TextToDisplay = vbNullString, "", " TextToDisplay:=" & .TextToDisplay & ", ") & _ ")" End With End If Print #iFileOut, " .NumberFormat = """ & .NumberFormat & """" Print #iFileOut, " .Orientation = " & .Orientation Print #iFileOut, " .ShrinkToFit = " & .ShrinkToFit With .Interior Print #iFileOut, " With .Interior" If .ColorIndex <> xlNone Then Print #iFileOut, " .ColorIndex = " & .ColorIndex If .PatternColor <> 0 Then Print #iFileOut, " .PatternColor = " & .PatternColor If .Pattern <> xlNone Then Print #iFileOut, " .Pattern = " & .Pattern Print #iFileOut, " End With" End With End With For lgBorder = xlEdgeLeft To xlEdgeRight With oXlCell.Borders(lgBorder) Print #iFileOut, " With .Borders(" & lgBorder & ")" Print #iFileOut, " .LineStyle = " & .LineStyle 'Print #iFileOut, " .ThemeColor = " & .ThemeColor If .TintAndShade <> 0 Then Print #iFileOut, " .TintAndShade = " & .TintAndShade If .Color <> 0 Then Print #iFileOut, " .Color = " & .Color Print #iFileOut, " .Weight = " & .Weight Print #iFileOut, " End With" End With Next lgBorder Print #iFileOut, " End With" Print #iFileOut, "" End If Next oXlCell Print #iFileOut, " End With" Print #iFileOut, "End Sub" Close #iFileOut End Function
Youtube downloader
Deep learning
Intro
I don’t know where this post will lead to (started the journey 01/21/19). The commitment is to get a Neuronal network add-in for Excel… limit time is end of 2019 (nothing bad would happen if goals could be achieved earlier). Absolutely, Excel is not the right tool to carry serious ANN -in terms of perfomance-, but, considering that all the computations can be shown in real time, and that you can mount a RAD model of every architecture, it should be considered among the better options to learn the subject from the basics. And the two final reasons where I finally arrive at: because I can do it, and because is so ubiquous that it does not limit to matematicians and IT people to play this things. If you want to make big stuff, you should consider other platforms and even other hardware… but that’s not my target and this is not your site if you have arrived here looking for other than Excel. Going to the business, from all the architectures that can be performed under the label of ANN, I’ll try to first pursue the ConvNet as they expose most of the algebra needed to perform the whole thing, so I hope it will be easier for me to adapt to other type of architectures. The final goal is to get a tool that can be good for any ANN model (considering the size limitations). This post should end fused with my previous post on Neuronal Network on Excel (task pending…).Milestones
Expecifically I’m looking after the following goals:- NN activation functions (those exposed on the wikipedia article). Achieved 01/22/19
- NN matrix algebra (multiplication, add/substraction, element-wise operations… with matrices/vectors). Half achieved, refactoring the MatLab translator module. Others should came from the JS translator.
- NN neuron manipulation (add/delete/copy/move).
- NN layer manipulation (add/delete/copy/move).
- NN specific functions. Filter, Pool, stride, convolute, backpropagate,…
- BMP/JPG import/export… someway achieved refactoring the ASCII Excel module.
Other’s implementations that I can base the thing on…
Not an exhaustive list, and maybe not any usefull, but here is a recopilation of other software I’ve seen to perform NN tasks:- SNNS (Stuttgart Neural Network Simulator)
- IMPLEMENTATION OF AN MS EXCEL TOOL FOR BACKPROPAGATION NEURAL NETWORK ALGORITHM IN ENVIRONMENTAL ENGINEERING EDUCATION (Selami DEMİR & others)
- XLStat
- deepExcel (even it’s satiric)
Bibliography
- Andrew Ng specialization course -videos- Deeplearning.ai, on Coursera platform. Very instructive, tips are explained in a very clear form, so anyone, even with not a high level of maths, can follow. You need to know and understand algebra. Only one handicap, IMO, is that it’s focused on TensorFlow (Google) platform.
- Jeremy Howard’s courses on fast.ai platform, online courses -also on Youtube– (and here a little trick if you’re to follow this course). To use on PyTorch, that seems to have its momentum by the end of 2018 and as a true OpenSource alternative can stay for long. Differences between them spotted here.
- Geoffrey Hinton Machine Learning course (Collin McDonell’s youtube list). You will need a stronger math basement to follow this lessons.
- Make Your Own Neural Network in Python book, by Tariq Rashid
- Ian Goodfellow/Yoshua Bengio/Aaron Courville MIT book. A lot of algebra there (maybe a hard path to go if you’re to learn about NN).
- Christopher Olah’s blog.
- Andrej Karpathy’s blog
- Andrew Trask’s blog
- Emill Wallner’s blog and all the other stuff on FloydHub
- https://pyrenn.readthedocs.io/en/latest/create.html
- https://medium.com/@geek_kid
- …
- Youtube. You can drown before getting bored or quit out, so here is my ANN channel list on the topic to have all the videos I liked in the same place.
Other info
- Short explanation on ANN and introduction to CNN. From same author, his repository on GitHub.
- Another explanation, from the basics.
- Activation functions:
- https://medium.com/@himanshuxd/activation-functions-sigmoid-relu-leaky-relu-and-softmax-basics-for-neural-networks-and-deep-8d9c70eed91e
- https://medium.com/the-theory-of-everything/understanding-activation-functions-in-neural-networks-9491262884e0
- Convolutional Networks (ConvNN or CNN)
- Capsule Networks (CapNN)
- https://github.com/sekwiatkowski/awesome-capsule-networks
- An interesting question on Quora: https://www.quora.com/Will-capsule-networks-replace-neural-networks
- https://hackernoon.com/what-is-a-capsnet-or-capsule-network-2bfbe48769cc
- https://www.oreilly.com/ideas/introducing-capsule-networks
- Sara Sabour, Nicholas Frosst, Geoffrey E. Hinton. Dynamic routing between capsules (PDF). November 2017.
- Geoffrey Hinton, Sara Sabour, Nicholas Frosst. Matrix capsules with EM routing (PDF). April 2018.
- Geoffrey E. Hinton, Alex Krizhevsky, Sida D. Wang. Transforming auto-encoders (PDF). June 2011.
- Aurélien Géron. Introducing capsule networks. O’Reilly Media, Ideas, February 2018.
- Max Pechyonkin. Understanding Hinton’s capsule networks series. AI3, November 2017.
- Nick Bourdakos. Understanding capsule networks — AI’s alluring new architecture. FreeCodeCamp, February 2018.
- Thibault Neveu. Understand and apply CapsNet on traffic sign classification. Becoming Human, November 2017.
- https://nips2018vigil.github.io/static/papers/accepted/7.pdf
- GANs:
- http://guimperarnau.com/blog/2017/03/Fantastic-GANs-and-where-to-find-them
- http://guimperarnau.com/blog/2017/11/Fantastic-GANs-and-where-to-find-them-II
- HTM
- Jean-Carlos Paredes, super simple sample of how to implement a decoder for MNIST dataset in Excel (just for the number “7”).
- Mike Pallister’s
- https://github.com/vrishank97/Introduction-to-Machine-Learning
- Excel NN
- David Smith, really nice implementations in Excel, part1, part2
- João Telo
- Emanuele Bonura, look at https://medium.com/@bonura.emanuele.sv/a-neural-network-in-11-lines-of-vba-4367a7219441, that has follow from this.