Re: Version Checking Subroutine
You are correct used when you need to be sure everyone has the latest version of a macro.
Re: Version Checking Subroutine
You are correct used when you need to be sure everyone has the latest version of a macro.
Basic version checking subroutine which you can call at form invokation. Result is displayed back to form in user message box of some type. Enjoy.
Private Sub UserForm_Initialize()
'INITIALIZE FORM
'VERSION CODE
currentv = "5.00"
Call CKV(currentv)
End Sub
Private Sub CKV(var1)
'FUNCTION TO DETERMINE IS USER HAS LATEST VERSION OF XLA
On Error Resume Next 'JUST IN CASE NO NETWORK DRIVE
Dim bypass As Label
Dim ToolPath2 As String
Dim tversion As String
Dim newversion As String
Dim CKV2 As Integer
Select Case var1
Case Is = ""
CKV2 = 0
GoTo bypass
Case Is <> ""
'DO NOTHING
End Select
'SET BASIC PATH
ToolPath2 = "C:\" 'BASE PATH GOES HERE
tversion = "versionlwp.vi" 'TEXT FILE WITH VI EXTENSION TO HOLD MOST CURRENT VERSION NUMBER ON FIRST LINE
'OPEN FILE AND CHECK VERSION
FileNumber2 = FreeFile
On Error Resume Next
Open ToolPath2 & tversion For Input As #FileNumber2
'READ FILE LINE 1
Line Input #FileNumber2, newversion
On Error GoTo 0
Close #FileNumber
'COMPARE
Select Case newversion
Case Is = var1
CKV2 = 0
Case Is <> var1
CKV2 = 1
End Select
'MESSAGE USER
Select Case CKV2
Case Is = 1
'USER MESSAGE
With frmYourFormName
.tb_status.Value = newversion & " Available-Update your Macro"
.tb_status.BackColor = &HC0FFFF
End With
Case Is = 0
With frmYourFormName
.tb_status.Value = currentv & " Version is current."
End With
End Select
bypass:
End Sub
Display More
Cool soundboard to annoy your coherts on Fridays. Easy to use. Create a folder on C Drive called Sounds or whatever you like. Toss some sound files in there. Ensure THE Directory is correct of where you put the sounds when you install it. All kinds of good stuff in there, some api, and other coolness.
:ninja:
Re: Send Dos Commands
I have been pawned. Your Geek power exceeds mine. LOL (In good fun)
Simple but goodie. Send DOS Commands from VBA. This examples assumes you have the net send service running. SP2 disables this service by default. Obviously you can send any DOS command that you like, this is just a simple example.
Populate forms from hidden XLA worksheet objects
Advanced Concept. Sometimes you have macros which need user parameters or your form objects such as listboxes need a list to load. Instead of storing the info in .txt or .ini text files store the info directly in your xla. The trick is reading the info from the xla. worksheets. As most know, as soon as you save your xls workbook as an xla your worksheets magically disappear. However, in reality they still exist as objects. Here are the steps
1) Build your code/form or whatever in your XLS workbook. This will be called your "Master Workbook".
2) Create a worksheet that has your list of parameters or whatever your macros need.
3) Save the XLS workbook as XLA. Voila your done.
In the sample you have the Master XLS as well as the XLA. Open the XLS and see the simple parameter list and see how it is stored on a worksheet. Next, close the XLS, and open the XLA. Do a ALT+F11 to open the visual basic editor then go to the mMain module. From the mMain module run the "ShowForm" macro. Your form will load and feed from hidden xla worksheet object.
Enjoy!:wowee:
'Method 1 - Read XLA worksheet values
strTest = ThisWorkbook.Sheets("shtFormFeed").Cells(2, 1).Value
'Method 2 - Read XLA worksheet values
With ThisWorkbook.Sheets("shtFormFeed")
strTest = .Cells(2, 1).Value
strTest2 = .Cells(2, 2).Value
End With
Archived Projects
http://programminglibrary.com/Programming%20…/downloads.aspx
Got to say, instead of messing around with API for finding logged in windows user name, simply use this short code. So simple my grandma could use it.
Couldn't get much simpler. Also many other things which can be extracted from the ENVIRON command. Here they are.
Code to View All Available ENVIRON info
Sub ENVIRON_DUMP()
Dim nCount As Integer
nCount = 1
Do Until Environ(nCount) = ""
Cells(nCount, 1).Value = Environ(nCount)
nCount = nCount + 1
Loop
End Sub
Enjoy.....................
Function to generate random colors. Also, can specifically exclude list of colors from list. Additionally, added macro to generate reference table of colors.
Enjoy....
Public pubPrevColor As Integer ' Set as public so value is remembered
Function intRndColor()
'USE - FUNCTION TO PICK RANDOM COLOR, ALSO ALLOWS EXCLUSION OF COLORS YOU DON'T LIKE
Dim Again As Label
Again:
intRndColor = Int((50 * Rnd) + 1) 'GENERATE RANDOM IN
Select Case intRndColor
Case Is = 1, 3, 21, 35, 36 'COLORS YOU DON'T WANT
GoTo Again
Case Is = pubPrevColor
GoTo Again
End Select
pubPrevColor = intRndColor 'ASSIGN CURRENT COLOR TO PREV COLOR
End Function
Sub ViewColors()
'USE THIS TO VIEW COLORS, PICK COLORS YOU DON'T WANT FOR RANDOM COLOR GENERATOR
Dim x As Integer
Sheets.Add
Cells(1, 1).Value = "Color Index#"
Cells(1, 2).Value = "Color Sample"
For x = 2 To 58
Cells(x, 1).Value = x - 2
Cells(x, 2).Select
With Selection.Interior
.ColorIndex = x - 2
.Pattern = xlSolid
End With
Next x
Cells.Select
Cells.EntireColumn.AutoFit
With Selection
.HorizontalAlignment = xlCenter
End With
Cells(1, 1).Select 'GO HOME
End Sub
Display More
[hr]*[/hr] Auto Merged Post Until 24 Hrs Passes;[dl]*[/dl]Note, Random color generator can be set to 56....
Excel XLA Installation - Distribution package. This is a version of my pseudo Excel Installation Package for distribution of your macros!
Design Theory:
Ok, without getting all crazy with the registry and such, package emulates an installation package. Tried to design with noobs in mind. Heavily commented
with decent amount of error checking. This is a hybrid of my thin weight installation package which has been modified and intesified. When opened .xla is actually hidden window.
What is it?
Allows you to package up your Excel XLA into a self contained installation file. Installation process saves file as XLA, then creates toolbar with new button which activates your macro.
How does it Work?
Simple, simply import your forms, and modules, configure the values in Public module.
Features:
-Customizable Button to activate your macro or form
-Customizable word Art Text for installation proccess
-Customizable Background color for installation proccess
-Package has been optimized so that very minimal configuration to deploy your macro.
-Simply configure required public vars, and import your forms and modules.
-Cool interface to give users feel of actual installation.
Important Notes:
-Hidden Help File, simply format->Sheet->Unhide->Help
-Be sure to configure all required vars
-To see how it works, put a break point in it and step through it
-Install package is designed to launch a SINGLE form or macro. Advanced users could probably modify it to do multiples
To see it in action, download file, and hit the install button. Then once you see how it works, modify it with your package. As always, open source, just ask you don't remove my credit. Modify how you like!
To large for post
http://%22http//programmingli…0Package.xls%22
Archived Downloads
http://%22http//programmingli…wnloads.aspx%22
Happy Coding............
Pretty Awesome Dom Viewer for Internet Explorer. Will Show realtime DOM of page. After installation if you can't see it you right click in right corner of toolbar on aarow to expand. Pretty cool especially if you are script injecting values into pages with VBA. Free Download. Enjoy
Ever try to build a excel dashboard or report and you never can get everything the right size and position. I had that same problem, I have designed this tool to allow you to exactly position and size all objects on your active worksheet. Through some sample object in workbook, but obviously you could use the tool to design a report or dashboard. Enjoy.
Archived downloads
http://programminglibrary.com/Programming%20…/downloads.aspx
Sure to enjoy this one. Lets you create Arrays within Arrays. Believe it or not, a very handy piece of code. Can be a memory hog though so use judiciously. To understand it fully, open your immediate window, and locals window then put a break in the code to step through it, and watch the variables.
Option Base 1
Private Type T_small
MArray2() As String
End Type
Sub Array_In_Array()
'USE - VBA ARRAY WITHIN ARRAY
'BROUGHT TO YOU BY YOUR www.programminglibrary.com
'OPEN SOURCE RULES!!!!
'DEC VARS
Dim MArray(10) As T_small ' SET SIZE OF MAIN ARRAY
'*******************************************************************
'FIRST BLOCK USED TO CREATE SIZE OF INNER ARRAY (MARRAY2)
'LOOP TO CREATE SIZE OF NEW VIRTUAL INNER ARRAY -OPTION BASE 1 MAKES IT START AT ONE INSTEAD OF 0
'IN THIS EXAMPLE WE WILL MAKE THE INNER ARRAY A SET VALUE OF 5, COULD BE ANYTHING OR DYNAMIC
'*******************************************************************
For x = 1 To 10
ReDim Preserve MArray(x).MArray2(5) 'RESIZE INNER ARRAY
Next x
'*******************************************************************
'SECOND BLOCK PUTTING VALUES INTO INNER ARRAY
'NOTE - YOU NEED 2 LOOPS TO CYCLE THRU, 1 FOR OUTTER ARRAY, ONE FOR THE INNER
'*******************************************************************
For x = 1 To 10
For xx = 1 To 5
MArray(x).MArray2(xx) = xx 'STORE VALUE TO INNER ARRAY - JUST STORING NUMBER HERE
Next xx
Next x
'*******************************************************************
'THIRD BLOCK IS TO READ CONTENTS, PRINTS TO THE IMMEDIATE WINDOW IF YOUR
'ARE IN CODE STEP MODE - SET BREAKPOINT IN CODE. CNTL + G FOR IMMEDIATE WINDEOW
'*******************************************************************
' DEBUG PRINT RESULTS
For x = 1 To 10
Debug.Print "----- MArray: " & x & " -----"
Debug.Print "----- Elements: " & UBound(MArray(x).MArray2) & " -----"
For xx = 1 To UBound(MArray(x).MArray2)
Debug.Print xx & ": " & MArray(x).MArray2(xx)
Next xx
Next x
End Sub
Display More
Ok, I posted simplistic code to log into i-google or other page. http://www.ozgrid.com/forum/showthread.php?t=80955
Problem is after testing I found that some pages never reach an IE ready state of 4, and only 3. Thus I tweaked the code so it auto toggles back to 3 and added DOM object detection to ensure proper object selection. Enjoy. Was geekin out a little, sorry.
Enum READYSTATE
READYSTATE_UNINITIALIZED = 0
READYSTATE_LOADING = 1
READYSTATE_LOADED = 2
READYSTATE_INTERACTIVE = 3
READYSTATE_COMPLETE = 4
End Enum
Sub AutoLogon()
'USE - AUTOLOGON
'*****************************************************
'***************** NOTES *****************************
'CODE TO MOVE TO A WEBPAGE
'ie.navigate ("https://webpage_goes_here")
'Call READYSTATE(ie)
'****************************************************
'****************************************************
'DEC VARS
Dim intPos1 As Integer 'DOM OBJECT 1
Dim intPos2 As Integer 'DOM OBJECT 2
Dim intDefState As Integer 'INT TO HOLD BASE STATE VALUE
Dim AGAIN as label
'SET VALS
Set ie = CreateObject("InternetExplorer.application") 'CREATE OBJECT
ie.Visible = True 'MAKE IE PAYNE VISIBLE
ie.navigate ("https://www.google.com/accounts/ServiceLogin?service=ig&passive=true&continue=http://www.google.com/ig%3Fhl%3Den&followup=http://www.google.com/ig%3Fhl%3Den&cd=US&hl=en&nui=1<mpl=default")
Call READYSTATE(ie) 'CHECK STATE OF PAGE
AGAIN: 'IF FINDDOM IS FAILING REPEAT THE PROCESS
intPos1 = 0
intPos1 = FindDom(ie, "Email")
If intPos1 = -1 Then GoTo AGAIN
intPos2 = 0
intPos2 = FindDom(ie, "Passwd")
If intPos1 = -1 Then GoTo AGAIN
'WEBPAGE INJECTION OF VALUES
ie.Document.forms(0).all(intPos1).value = "youremail"
Call READYSTATE(ie)
ie.Document.forms(0).all(intPos2).value = "yourpass"
Call READYSTATE(ie)
ie.Document.forms(0).submit 'HIT SUBMIT
End Sub
Sub READYSTATE(ie)
'WAIT ROUTINE TO WAIT FOR PAGE TO BECOME INTERACTIVE
'SET VALS
intDefState = 4
bump = 0
Do
If ie.READYSTATE = intDefState Then
ie.Visible = True
Exit Do
Else
DoEvents
End If
bump = bump + 1 'SMARTSTATE COUNTER
'IF READYSTATE NEVER REACHES 4 ROLL BACK TO 3 SOME PAGES WILL NEVER REACH 4
If bump > 1000 Then
If intDefState = 4 Then
intDefState = 3
ElseIf intDefState = 3 Then
intDefState = 4
End If
Exit Do
End If
Loop
End Sub
Function FindDom(ie, strLookDom As String)
'USE-SCAN DOM TO FIND OBJECT ON WEBPAGE
'DEC VARS
Dim lblDie As Label
Dim lblDie2 As Label
Dim strTestval As String 'STRING VAR TO HOLD DOM ID
On Error GoTo lblDie
intNuminDom = ie.Document.all.Length 'GET COUNT OF DOM OBJECTS ON WEBPAGE
For x = 0 To intNuminDom
strTestval = UCase(ie.Document.forms(0).all(x).ID)
If strTestval = UCase(strLookDom) Then
FindDom = x
GoTo lblDie2
End If
Next x
lblDie: 'PREVENT ENDLESS LOOP
lblDie2: 'DOUBLE CHECK VALUE BEFORE PROCEEDING
If Len(Trim(FindDom)) = 0 Then FindDom = -1
End Function
Display More
Here is a short but sweet script to login to i-Google. Script could be changed to suit a variety of needs. Beware of pages that have login objects located within a frame. That gets a little bit trickier. To change to other sites simply change web address, and ie form object names to match that of your login page. To get these go to your login page, right click view source, and get form object ids.
Enjoy
Sub IGoogle_AutoLogin()
Set ie = CreateObject("InternetExplorer.application")
ie.Visible = True
ie.navigate ("https://www.google.com/accounts/ServiceLogin?service=ig&passive=true&continue=http://www.google.com/ig%3Fhl%3Den&followup=http://www.google.com/ig%3Fhl%3Den&cd=US&hl=en&nui=1<mpl=default")
Do
If ie.readyState = 4 Then
ie.Visible = True
Exit Do
Else
DoEvents
End If
Loop
'USE VIEW SOURCE TO GET FORM ELEMENT IDS
ie.Document.forms(0).all("Email").Value = "yourvalue here"
ie.Document.forms(0).all("Passwd").Value = "yourvaluehere"
ie.Document.forms(0).submit
End Sub
Display More
Users are always complaining about tab sequence on user forms. With this little tidbit you can integrate the ability for a user to set their own tab stop sequence. The load and save routines are not included but could easily be integrated to save to access db or other. Enjoy!
This is an Access script which I commonly use to retreive data from Access DAtabases. Has been heavily commented to aid newbies in their quest for data. In addition, you can encase it into a loop if you prefer. Anyway, enjoy...
'Make Sure you Reference the Following in your Project
'Microsoft ActiveX Data Objects 2.8 Library
'Microsoft DAO 3.6 Object Library
Public Sub GetCn(ByRef dbcon As ADODB.Connection, ByRef dbrs As ADODB.Recordset, _
sqlstr As String, dbfile As String, usernm As String, pword As String, toggle As Integer)
'TO INCREASE SPEED OF REPETITIVE QUERIES, CHANGE TOGGLE TO 1 AFTER 1ST QUERY SO YOU ARE NOT REOPENING CONNECTION EACH TIME
If toggle = 0 Then
Set dbcon = New ADODB.Connection
dbcon.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbfile & ";", _
usernm, pword
End If
With dbcon
.CursorLocation = adUseClient 'disconnect recordset
Set dbrs = .Execute(sqlstr)
End With
End Sub
Sub GetAccessData()
'USE-GET ACCESS DATA
'################################### DEC VARS ##########################
'GEN VARS
Dim filenm As String 'DATABASE PATH AND NAME
Dim ConnectionErr As Label 'CONNECTION ERROR LABEL
Dim Bypass As Label 'LABEL TO JUMP ERROR BLOCK
Dim TryAgain As Label 'LABEL TO LOOP BACK AND TRY AGAIN
'CONNECTION VARS---------------------------------------------------------
Dim adoconn As ADODB.Connection
Dim adors As ADODB.Recordset
Dim sql As String
'################################### END DEC VARS ######################
'################################### SET VALS ##########################
filenm = "C:\MyDatabase.MDB" 'SET DEFAULT DATABASE
sql = "Select * from Whatever" 'PUT YOUR SQL HERE
ErrorCount = 0 'INITIALIZE ERROR COUNTER
'################################### END SET VALS ######################
'################################### GET THE DATA ######################
On Error GoTo ConnectionErr 'IN CASE PROBLEM CONNECTING GOTO ERROR BLOCK AND INCREMENT ERRORCOUNT
TryAgain:
Call GetCn(adoconn, adors, sql, filenm, "", "", 0) 'REPLACE COMMAS WITH USERNAME AND PASSWORD IF DATABASE USES IT
ErrorCount = 0 'RESET ERROR COUNT VAR BECAUSE DATA RETRIEVAL WAS SUCCESSFULL
adors.MoveFirst
If Not adors.BOF Then
Cells(1, 1).Value = adors(0) 'BY DEFAULT PUTTING DATA IN CELL A1- COULD USE VARS HERE FOR CYCLIC DATA RETRIEVAL
End If
'CLEAN UP OPERATIONS
adors.Close
adoconn.Close
Set adors = Nothing
Set adoconn = Nothing
GoTo Bypass 'JUMP OVER ERROR BLOCK
'################################## END GET DATA######################
'############################### ERROR BLOCK ######################
ConnectionErr:
ErrorCount = ErrorCount + 1
Set adors = Nothing
Set adoconn = Nothing
'THIS IS AN ERROR COUNTER, WILL RETRY MAX TIMES THEN OPERATION TERMINATES
If ErrorCount >= 200 Then
MsgBox "Max Error Count Exceeded. Operation will terminate", vbInformation, "UserMessage"
End
End If
GoTo TryAgain: 'LOOP BACK AND TRY AGAIN
'############################### END ERROR BLOCK ##################
Bypass: 'ERROR JUMP LABEL
End Sub
Display More
Re: Run Command Button Click From Another Command Button
humm, getting sidetracked. The goal here is creating a button, which the user can choose will fire a series of buttons when pushed. Basically it is like the Record macro button. Let say one user wanted buttons A, B, C fired when they pushed the super button. No another user may want C, B, A, D fired when they push the super button. I was trying to avoid endless barage of if statements. Basically the button names could be stored in configuration file as text strings and would load @ runtime for any users form. Thus a single function to activate the click command based on the text strings.
Re: Activate The Button_click Method Via Variable/string
Concept would be for creating programmable buttons that user could specify series of buttons to be clicked. In essence, enable user to create a "Macro" on a form which would autoclick a series of buttons that they specify.
Re: Activate The Button_click Method Via Variable/string
No luck. Dumped and stated not found
Let me say I have a userform with a button on it named But1. Is it possible to store But1 into a variable then activate the But1_Click action using a variable?
Now, how would you activate the But1_Click method using strButname variable. With listboxes you can use the Control(strListboxName) methodology?
This doesn't work, but gives you an idea of what I am trying to do.
Controls(strButname)_click