Need help with Userform and make compatible with 32 and 64 bit

greegan

Well-known Member
Joined
Nov 18, 2009
Messages
644
Office Version
  1. 365
Platform
  1. Windows
I've created a userform that sends as many as 17 fields, not all required, to a table. It works awesome except when my work associate opens it up on his 64 bit machine. Most of us use 32 bit. Something about his machine that runs Windows and Mac. I don't that is the issue, just it needs to be 64 bit compatible. And I have no clue how to do that. I've been trying to decipher the websites and other links from MrExcel forums trying to figure it out. I just found out I'm not the smartest man in the world. Hmmm

I'll include all the code here. There isn't anything that gives away my company IP.

Your help in solving this is most appreciated.

This is in Module1

VBA Code:
Sub MyCell()
'originally coded as VB script by A.Vials, converted to VBA by Sly
Dim objInfo
Dim strLDAP
Dim strFullName
  
Set objInfo = CreateObject("ADSystemInfo")
strLDAP = objInfo.UserName
Set objInfo = Nothing
strFullName = GetUserName(strLDAP)
  
Worksheets("Engine").Range("B6") = strFullName '<== Adjust cell Reference
  
End Sub
 
Function GetUserName(strLDAP)
  Dim objUser
  Dim strName
  Dim arrLDAP
  Dim intIdx
  
  On Error Resume Next
  strName = ""
  Set objUser = GetObject("LDAP://" & strLDAP)
  If Err.Number = 0 Then
    strName = objUser.Get("givenName") & Chr(32) & objUser.Get("sn")
  End If
  If Err.Number <> 0 Then
    arrLDAP = Split(strLDAP, ",")
    For intIdx = 0 To UBound(arrLDAP)
      If UCase(Left(arrLDAP(intIdx), 3)) = "CN=" Then
        strName = Trim(Mid(arrLDAP(intIdx), 4))
      End If
    Next
  End If
  Set objUser = Nothing
  
  GetUserName = strName
  
End Function
Not sure where I grabbed the above code from but A.Vials, Sly have my thanks.



This is in the Userform code

VBA Code:
Private Declare Function FindWindow _
    Lib "user32" _
        Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) _
    As Long

Private Declare Function GetWindowLong _
    Lib "user32" _
        Alias "GetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long) _
    As Long

Private Declare Function SetWindowLong _
    Lib "user32" _
        Alias "SetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long, _
            ByVal dwNewLong As Long) _
    As Long

Private Declare Function DrawMenuBar _
    Lib "user32" ( _
        ByVal hWnd As Long) _
    As Long

Private Const GWL_STYLE As Long = (-16)
Private Const WS_SYSMENU As Long = &H80000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000

Private Sub cmdSubmit_Click()

'   when we use the Continue button




Dim TargetRow As Integer    'variable for position control



TargetRow = Sheets("Engine").Range("B3").Value + 1  'make variable equal to COUNTA formula on worksheet


    ''''BEGIN INPUT DATA INTO DATABASE'''
Sheets("Data").Range("DataStart").Offset(TargetRow, 0).Value = TargetRow    'Ref
Sheets("Data").Range("DataStart").Offset(TargetRow, 1).Value = lbInputDate 'tbDate  'Date
'Sheets("Data").Range("DataStart").Offset(TargetRow, 2).Value = lbInputTime 'tbDate  'Date
Sheets("Data").Range("DataStart").Offset(TargetRow, 3).Value = lbUser    'Age
Sheets("Data").Range("DataStart").Offset(TargetRow, 4).Value = tbTicket    'Age
Sheets("Data").Range("DataStart").Offset(TargetRow, 5).Value = tbAccount 'Gender combo box
Sheets("Data").Range("DataStart").Offset(TargetRow, 6).Value = tbOrder 'Region combo box
Sheets("Data").Range("DataStart").Offset(TargetRow, 7).Value = cbAffiliate    'Job combo box
Sheets("Data").Range("DataStart").Offset(TargetRow, 8).Value = cbVia   'Driving combo box
Sheets("Data").Range("DataStart").Offset(TargetRow, 9).Value = cbOrigin   'Smoking combo box
Sheets("Data").Range("DataStart").Offset(TargetRow, 10).Value = cbQueue  'Exercist text box
Sheets("Data").Range("DataStart").Offset(TargetRow, 11).Value = cbWho  'Marital Status combo box
Sheets("Data").Range("DataStart").Offset(TargetRow, 12).Value = cbEmail    'Age
Sheets("Data").Range("DataStart").Offset(TargetRow, 13).Value = cbOutbound    'Age
Sheets("Data").Range("DataStart").Offset(TargetRow, 14).Value = cbBILLING  'Exercist text box
Sheets("Data").Range("DataStart").Offset(TargetRow, 15).Value = cbExistingPatient  'Marital Status combo box
Sheets("Data").Range("DataStart").Offset(TargetRow, 16).Value = cbNewPatient    'Age
Sheets("Data").Range("DataStart").Offset(TargetRow, 17).Value = cbNoSale    'Age



    '''END INPUT DATA INTO DATABASE'''

    
Unload ufDispositioner  'makes uf disappear

MsgBox "Your disposition has been added to the database.", 0, "Complete"





End Sub


''''' More code from the net with no name to give credit to

Private Sub Test()
 Dim strUser As String * 50
 Dim lngDummy As Long
 lngDummy = GetUserName(strUser, 49)
 Worksheets("Engine").Range("B6").Value = strUser
End Sub

'The following procedure adds the min and max buttons to your form when it activates. Add it to your form's code module (or add the code to your existing UserForm_Activate procedure if you have one):

Private Sub UserForm_Activate()
    
    Dim Frmhdl As Long
    Dim lStyle As Long
    
    Frmhdl = FindWindow(vbNullString, Me.Caption)
    
    lStyle = GetWindowLong(Frmhdl, GWL_STYLE)
    lStyle = lStyle Or WS_SYSMENU
    lStyle = lStyle Or WS_MINIMIZEBOX
    lStyle = lStyle Or WS_MAXIMIZEBOX
    
    SetWindowLong Frmhdl, GWL_STYLE, (lStyle)
    DrawMenuBar Frmhdl

Application.UserName = Worksheets("Engine").Range("B6").Value

lbInputDate.Caption = Worksheets("Engine").Range("B1").Value
lbInputTime.Caption = Worksheets("Engine").Range("B2").Value
Call MyCell
lbUser.Caption = Worksheets("Engine").Range("B6").Value


End Sub



Private Sub cmdQuit_Click()
Unload ufDispositioner
End Sub


Thank you


-- g
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Hello greegan,

Delete the API calls in your UserForm and replace them with the code below...
Code:
Private Const GWL_STYLE      As Long = (-16)
Private Const WS_SYSMENU     As Long = &H80000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000

#If VBA7 Then
    If Win64 Then
        Private Declare PtrSafe Function FindWindow Lib "User32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
        Private Declare PtrSafe Function GetWindowLong Lib "User32.dll" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLong Lib "User32.dll" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        Private Declare PtrSafe Function DrawMenuBar Lib "User32.dll" (ByVal hWnd As LongPtr) As Long
    Else
        Private Declare PtrSafe Function FindWindow Lib "User32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare PtrSafe Function GetWindowLong Lib "User32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
        Private Declare PtrSafe Function SetWindowLong Lib "User32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
        Private Declare PtrSafe Function DrawMenuBar Lib "User32.dll" (ByVal hWnd As Long) As Long
    End If
#ElseIf VBA6 Then
        Private Declare Function FindWindow Lib "User32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare Function GetWindowLong Lib "User32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
        Private Declare Function SetWindowLong Lib "User32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
        Private Declare Function DrawMenuBar Lib "User32.dll" (ByVal hWnd As Long) As Long
#End If
 
Upvote 0
Hello greegan,

Sorry, in my previous post I forgot to add the # to one of the If Then statements. Here is the correct code.
Code:
Private Const GWL_STYLE      As Long = (-16)
Private Const WS_SYSMENU     As Long = &H80000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function FindWindow Lib "User32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
        Private Declare PtrSafe Function GetWindowLong Lib "User32.dll" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLong Lib "User32.dll" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        Private Declare PtrSafe Function DrawMenuBar Lib "User32.dll" (ByVal hWnd As LongPtr) As Long
    #Else
        Private Declare PtrSafe Function FindWindow Lib "User32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare PtrSafe Function GetWindowLong Lib "User32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
        Private Declare PtrSafe Function SetWindowLong Lib "User32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
        Private Declare PtrSafe Function DrawMenuBar Lib "User32.dll" (ByVal hWnd As Long) As Long
    #End If
#ElseIf VBA6 Then
        Private Declare Function FindWindow Lib "User32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare Function GetWindowLong Lib "User32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
        Private Declare Function SetWindowLong Lib "User32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
        Private Declare Function DrawMenuBar Lib "User32.dll" (ByVal hWnd As Long) As Long
#End If
 
Upvote 0
Solution
Hello greegan,

Sorry, in my previous post I forgot to add the # to one of the If Then statements. Here is the correct code.
Code:
Private Const GWL_STYLE      As Long = (-16)
Private Const WS_SYSMENU     As Long = &H80000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function FindWindow Lib "User32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
        Private Declare PtrSafe Function GetWindowLong Lib "User32.dll" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Private Declare PtrSafe Function SetWindowLong Lib "User32.dll" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        Private Declare PtrSafe Function DrawMenuBar Lib "User32.dll" (ByVal hWnd As LongPtr) As Long
    #Else
        Private Declare PtrSafe Function FindWindow Lib "User32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare PtrSafe Function GetWindowLong Lib "User32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
        Private Declare PtrSafe Function SetWindowLong Lib "User32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
        Private Declare PtrSafe Function DrawMenuBar Lib "User32.dll" (ByVal hWnd As Long) As Long
    #End If
#ElseIf VBA6 Then
        Private Declare Function FindWindow Lib "User32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare Function GetWindowLong Lib "User32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
        Private Declare Function SetWindowLong Lib "User32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
        Private Declare Function DrawMenuBar Lib "User32.dll" (ByVal hWnd As Long) As Long
#End If
That is freaking awesome ! I'm not at work right now to test it but will be in about 12 hours. This something I would never have figured out on my own. Thank you. I will post results when I test it.

-- g
 
Upvote 0

Forum statistics

Threads
1,224,827
Messages
6,181,197
Members
453,022
Latest member
RobertV1609

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top