Showing posts with label hidemyvba. Show all posts
Showing posts with label hidemyvba. Show all posts

Thursday, January 11, 2018

Cursors.io Script. Write anything!

Ever got frustrated in http://cursors.io game and wanted to yell at another person?  Well now you can!

This script requires you to have Excel installed, otherwise it will not work.

Have fun with it! Either copy and paste the code into notepad and save as a .vbs file, or download the file here.

 Public Const MOUSEEVENTF_LEFTDOWN = &H2  
 Public Const MOUSEEVENTF_LEFTUP = &H4  
 Public Const MOUSEEVENTF_RIGHTDOWN = &H8  
 Public Const MOUSEEVENTF_RIGHTUP = &H10  
 On Error Resume Next  
    ' GetCursorPos requires a variable declared as a custom data type  
    ' that will hold two integers, one for x value and one for y value  
    Class POINTAPI  
      Public X_Pos  
      Public Y_Pos  
    End Class  
  Set Excel = WScript.CreateObject("Excel.Application")  
  Set Orig = New POINTAPI  
  Set Start = New POINTAPI  
  Dim scode1,owb1,omod1, iSize, iDelay, iRpt, text  
  Set owb1=Excel.workbooks.add  
  iSize = InputBox("What size do you want? (1-50: Recommended 7)")  
  If iSize = "" Then  
  iSize = 7  
  End If  
  iDelay = InputBox("What delay do you want? (Recommended 90)")  
  If iDelay = "" Then  
  iDelay = 90  
  End If  
  iRpt = InputBox("How many times would you like to repeat the text?")  
  If iRpt = "" Then  
  iRpt = 1  
  End If  
  scode1="Public Declare PtrSafe 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)" & vbCrLf  
  scode1= scode1 & "Declare PtrSafe Function GetCursorPos Lib ""user32"" (lpPoint As POINTAPI) As Long" & vbCrLf  
  scode1= scode1 & "Public Declare PtrSafe Sub keybd_event Lib ""user32"" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)" & vbCrLf  
  scode1= scode1 & "Public Declare PtrSafe Function MapVirtualKey Lib ""user32"" Alias ""MapVirtualKeyA"" (ByVal wCode As Long, ByVal wMapType As Long) As Byte" & vbCrLf  
  scode1= scode1 & "Type POINTAPI" & vbcrlf & "X_Pos As Long" & vbcrlf & "Y_Pos As Long" & vbcrlf & "End Type" & vbCrLf  
  scode1= scode1 & "Public Const KEYEVENTF_EXTENDEDKEY = &H1" & vbCrLf  
  scode1= scode1 & "Public Const KEYEVENTF_KEYUP = &H2" & vbCrLf  
  scode1 = scode1 & "Sub doMouse (Event1)" & vbcrlf  
  scode1 = scode1 & "mouse_event Event1, 0, 0, 0, 0" & vbCrLf  
  scode1 = scode1 & "End Sub" & vbCrLf  
  scode1 = scode1 & "Function getX ()" & vbcrlf  
  scode1 = scode1 & "Dim myPos as POINTAPI" & vbcrlf  
  scode1 = scode1 & "GetCursorPos myPos" & vbcrlf  
  scode1 = scode1 & "getX = myPos.X_Pos" & vbcrlf  
  scode1 = scode1 & "End Function" & vbcrlf  
  scode1 = scode1 & "Function getY ()" & vbcrlf  
  scode1 = scode1 & "Dim myPos as POINTAPI" & vbcrlf  
  scode1 = scode1 & "GetCursorPos myPos" & vbcrlf  
  scode1 = scode1 & "getY = myPos.Y_Pos" & vbcrlf  
  scode1 = scode1 & "End Function" & vbCrLf  
  scode1 = scode1 & "Sub myShiftKey (isDown as Boolean)" & vbcrlf  
  scode1 = scode1 & "If isDown then" & vbcrlf  
  scode1 = scode1 & "keybd_event &H10, MapVirtualKey(&H10, 0), 0, 0" & vbcrlf  
  scode1 = scode1 & "else" & vbCrLf  
  scode1 = scode1 & "keybd_event &H10, MapVirtualKey(&H10, 0), KEYEVENTF_KEYUP, 0" & vbCrLf  
  scode1 = scode1 & "End If" & vbCrLf  
  scode1 = scode1 & "End Sub" & vbCrLf  
  Set omod1=owb1.vbproject.vbcomponents.add(1)  
  omod1.codemodule.addfromstring scode1  
 For iL = 1 To iRpt  
  Move_Cursor  
  SetCursorPos1 start.X_Pos, Start.Y_Pos  
  start.x_pos = start.x_pos + 1  
 Next  
 'cleanup  
  Set omod1=nothing  
  owb1.saved=true  
  owb1.close  
  Set owb1=nothing  
  Excel.quit  
  Set Excel=Nothing  
  If Err.Number <> 0 Then  
  MsgBox "Error Occurred: " & Err.Description  
  End If  
 Sub Move_Cursor()  
   'Dim Hold As POINTAPI  
   Set Hold = New POINTAPI  
   'Dim text As String  
   'Dim i As Integer  
   'you must always start and end in the upper left corner  
   If start.X_Pos = 0 Then  
    text = InputBox("What Do you want to write with the mouse?")  
    WScript.Sleep 4000  
   End If  
   GetCursorPos1 orig  
   If start.X_Pos = 0 Then  
    GetCursorPos1 Start  
   End If  
   For i = 1 To Len(text)  
    shiftDown True  
    WScript.Sleep iDelay/2  
     mouse_event1 MOUSEEVENTF_LEFTDOWN   
     Select Case LCase(Mid(text, i, 1))  
       Case "a"  
         down  
         down  
         up  
         right  
         up  
         left  
         right  
         down  
         down  
         up  
         up  
         left  
       Case "b"  
         right  
         down  
         left  
         up  
         down  
         down  
         right  
         up  
         up  
         left  
       Case "c"  
         right  
         left  
         down  
         down  
         right  
         left  
         up  
         up  
       Case "d"  
         right  
         down  
         down  
         left  
         up  
         up  
       Case "e"  
         right  
         left  
         down  
         right  
         left  
         down  
         right  
         left  
         up  
         up  
       Case "f"  
         right  
         left  
         down  
         right  
         left  
         down  
         up  
         up  
       Case "g"  
         right  
         down  
         down  
         left  
         right  
         up  
         left  
         up  
       Case "h"  
         down  
         right  
         up  
         down  
         down  
         up  
         left  
         down  
         up  
         up  
       Case "i"  
         right  
         down  
         down  
         left  
         right  
         right  
         left  
         up  
         up  
         right  
         left  
       Case "j"  
         right  
         down  
         down  
         left  
         up  
         down  
         right  
         up  
         up  
         left  
       Case "k"  
         down  
         diagupRight  
         diagdownLeft  
         diagdownRight  
         diagupLeft  
         down  
         up  
         up  
       Case "l"  
         down  
         down  
         right  
         left  
         up  
         up  
       Case "m"  
         down  
         down  
         up  
         up  
         right  
         down  
         up  
         right  
         down  
         down  
         up  
         up  
         left  
       Case "n"  
         down  
         up  
         right  
         down  
         up  
         left  
       Case "o"  
         down  
         right  
         up  
         left  
       Case "p"  
         down  
         down  
         up  
         right  
         up  
         left  
       Case "q"  
         down  
         right  
         up  
         left  
         right  
         down  
         down  
         right  
         left  
         up  
         up  
       Case "r"  
         down  
         down  
         up  
         diagdownRight  
         diagupLeft  
         right  
         up  
         left  
       Case "s"  
         right  
         left  
         down  
         right  
         down  
         left  
         right  
         up  
         left  
         up  
       Case "t"  
         right  
         down  
         down  
         up  
         up  
         right  
         left  
       Case "u"  
         down  
         right  
         up  
         down  
         left  
         up  
       Case "v"  
         diagdownRight  
         diagupRight  
         diagdownLeft  
         diagupLeft  
       Case "w"  
         diagdownRight  
         diagupRight  
         diagdownRight  
         diagupRight  
         diagdownLeft  
         diagupLeft  
       Case "x"  
         diagdownRight  
         diagdownRight  
         diagupLeft  
         diagupRight  
         diagdownLeft  
         diagdownLeft  
         diagupRight  
         diagupLeft  
       Case "y"  
         diagdownRight  
         diagupRight  
         diagdownLeft  
         diagdownLeft  
         diagupRight  
         diagupLeft  
       Case "z"  
         right  
         diagdownLeft  
         right  
         left  
         diagupRight  
         left  
     End Select  
     mouse_event1 MOUSEEVENTF_LEFTUP  
     right  
     right  
   Next   
   shiftDown False  
 End Sub  
 Sub SetCursorPos1(x, y)  
  Excel.ExecuteExcel4Macro ("CALL(""user32"",""SetCursorPos"",""JJJ""," & x & "," & y & ")")  
 End Sub  
 Function GetCursorPos1(ByRef myPoint)  
  myPoint.X_Pos=Excel.run("getX")  
  myPoint.Y_Pos=Excel.run("getY")  
 End Function  
 Sub left()  
   'Dim Hold As POINTAPI  
   Set Hold = New POINTAPI  
   'GetCursorPos1 Hold  
   SetCursorPos1 orig.X_Pos - iSize, orig.Y_Pos  
   orig.X_pos = orig.x_pos - iSize  
   WScript.Sleep iDelay  
 End Sub  
 Sub right()  
   'Dim Hold As POINTAPI  
   Set Hold = New POINTAPI  
   'GetCursorPos1 Hold  
   SetCursorPos1 orig.X_Pos + iSize, orig.Y_Pos  
   orig.X_pos = orig.x_pos + iSize  
   WScript.Sleep iDelay  
 End Sub  
 Sub down()  
   'Dim Hold As POINTAPI  
   Set Hold = New POINTAPI  
   'GetCursorPos1 Hold  
   SetCursorPos1 orig.X_Pos, orig.Y_Pos + iSize  
   orig.y_pos = orig.y_pos + iSize  
   WScript.Sleep iDelay  
 End Sub  
 Sub up()  
   'Dim Hold As POINTAPI  
   Set Hold = New POINTAPI  
   'GetCursorPos1 Hold  
   SetCursorPos1 orig.X_Pos, orig.Y_Pos - iSize  
   orig.Y_pos = orig.y_pos - iSize  
   WScript.Sleep iDelay  
 End Sub  
 Sub diagdownRight()  
   'Dim Hold As POINTAPI  
   Set Hold = New POINTAPI  
   'GetCursorPos1 Hold  
   SetCursorPos1 orig.X_Pos + iSize, orig.Y_Pos + iSize  
   orig.X_pos = orig.x_pos + iSize  
   orig.y_pos = orig.y_pos + iSize  
   WScript.Sleep iDelay  
 End Sub  
 Sub diagupRight()  
   'Dim Hold As POINTAPI  
   Set Hold = New POINTAPI  
   'GetCursorPos1 Hold  
   SetCursorPos1 orig.X_Pos + iSize, orig.Y_Pos - iSize  
   orig.X_pos = orig.x_pos + iSize  
   orig.y_pos = orig.y_pos - iSize  
   WScript.Sleep iDelay  
 End Sub  
 Sub diagdownLeft()  
   'Dim Hold As POINTAPI  
   Set Hold = New POINTAPI  
   'GetCursorPos1 Hold  
   SetCursorPos1 orig.X_Pos - iSize, orig.Y_Pos + iSize  
   orig.X_pos = orig.x_pos - iSize  
   orig.y_pos = orig.y_pos + iSize  
   WScript.Sleep iDelay  
 End Sub  
 Sub diagupLeft()  
   'Dim Hold As POINTAPI  
   Set Hold = New POINTAPI  
   'GetCursorPos1 Hold  
   SetCursorPos1 orig.X_Pos - iSize, orig.Y_Pos - iSize  
   orig.X_pos = orig.x_pos - iSize  
   orig.y_pos = orig.y_pos - iSize  
   WScript.Sleep iDelay  
 End Sub  
 Sub mouse_event1 (myEvent)  
  Excel.run("DoMouse(" & myEvent & ")")  
 End Sub  
 Sub shiftDown (isDown)  
  Excel.run("myShiftKey(" & isDown & ")")  
 End Sub  

Place Secret Messages in Excel

Ever want to send a secret message to your friend?  Want it to be secure and encrypted and not immediately obvious to anyone who looks at it?  Well how about using Excel and VBA to create a workbook with a hidden message!

Simply Create a new VBA module and paste the following code in it.

 Public Function encrypt(sText As String) As String  
   Dim i As Long  
   Dim Order() As Variant  
   Dim myLetter As Integer  
   Dim newString As String  
   sText = LCase(sText)  
   Order = Array(97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, _  
          110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122)  
   For i = 1 To Len(sText)  
     myLetter = Asc(Mid(sText, i, 1)) - 96  
     If myLetter &lt; 0 Or myLetter &gt; 26 Then  
       newString = newString &amp; Chr(myLetter + 96)  
     Else  
       newString = newString &amp; Chr(Order(myLetter - 1))  
       algorithm Order, myLetter  
     End If  
   Next  
   encrypt = newString  
 End Function  
 Function decrypt(sText As String) As String  
   Dim i As Long  
   Dim NormOrder() As Variant  
   Dim Order() As Variant  
   Dim myLetter As Integer  
   Dim newString As String  
   sText = LCase(sText)  
   NormOrder = Array(97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, _  
          110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122)  
   Order = Array(97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, _  
          110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122)  
   For i = 1 To Len(sText)  
     myLetter = Asc(Mid(sText, i, 1)) - 96  
     If myLetter &lt; 0 Or myLetter &gt; 26 Then  
       newString = newString &amp; Chr(myLetter + 96)  
       GoTo nexti  
     End If  
     If i = 1 Then  
       myLetter = Asc(Mid(sText, i, 1)) - 96  
       newString = Mid(sText, i, 1)  
       algorithm Order, myLetter  
     Else  
       myLetter = Asc(Mid(sText, i, 1))  
       myLetter = getPlace(myLetter, Order)  
       newString = newString &amp; Chr(NormOrder(myLetter))  
   'Debug.Assert Chr(NormOrder(myLetter)) &lt;&gt; "i"  
       'cycle the order again  
       myLetter = NormOrder(myLetter) - 96  
       algorithm Order, myLetter  
     End If  
 nexti:  
   Next  
   decrypt = newString  
 End Function  
 Function getPlace(chrNum As Integer, Order() As Variant) As Integer  
   Dim i As Integer  
   For i = LBound(Order) To UBound(Order)  
     If Order(i) = chrNum Then  
       getPlace = i  
       Exit Function  
     End If  
   Next i  
 End Function  
 Function algorithm(Order() As Variant, letterNum As Integer)  
   Dim i  
   Dim j As Double  
   Dim newOrder() As Variant  
   Dim temp  
   Dim offset As Double  
   ReDim newOrder(LBound(Order) To UBound(Order))  
   letterNum = letterNum - 1  
   'initial switch  
   temp = Order(UBound(Order))  
   Order(UBound(Order)) = Order(letterNum)  
   Order(letterNum) = temp  
   offset = Round(Exp(letterNum) / 2)  
 reTest:  
   If offset &gt; UBound(Order) Then  
     offset = offset - (UBound(Order) * Application.WorksheetFunction.RoundDown(offset / (UBound(Order)), 0))  
     GoTo reTest  
   End If  
   'shift entire array  
   For i = LBound(Order) To UBound(Order)  
     j = i + offset  
     If j &gt; 25 Then j = j - 26  
     newOrder(UBound(Order) - i) = Order(j)  
   Next i  
   'replace the order variable  
   For i = LBound(newOrder) To UBound(newOrder)  
     Order(i) = newOrder(i)  
   Next i  
 End Function  

The idea is simple. Instead of storing text in the workbook, this will store the ASCII character codes in the form of font sizes in your workbook!

In addition to this simple method of hiding a message in a workbook, this code also encrypts the ascii character codes by offsetting the characters.


To dig deeper:


Give each letter a number. For example:

A = 1, B = 2, C = 3,...,Z = 26


get it?


Let's say your message is "Hi":


Your first letter would be H, so the number 8.

well now, we don't want to simply store the letter i as number 9, instead, we will offset the entire alphabet by the letter H--AKA the number 8.


so now, the letter i becomes 9 + 8 = 17


so the encoded message would be the numbers 8, 17.


The result are two cells in the Excel Sheet with font sizes 8 and 17.


Have fun with it!


Tuesday, November 14, 2017

About This Blog

Thank you for visiting my blog!

Let's make this brief and easy!  I have used Excel for many things--especially VBA coding. I have been employed to create spreadsheets and powerful Excel tools, I have learned many things on my own for fun, and I use Excel to manage things like my budget and more.

I decided that it might be of help to others if I made some of my tricks and tips public. I do not anticipate posting a significant amount of posts, but when I occasionally find something particularly useful then you will see it!

For the most part, a diligent Excel user can find out how to do just about anything they want on the web. In fact, I often find little tidbits of code on the internet that I use!

Please enjoy!

VBA Add an animated Notification Box to your Excel Program

For those of us who create programs and add-ins in Excel, we are very, very familiar with the message box.  The message box gives us the opp...