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

G

greegan

Well-known Member
Joined
Nov 18, 2009
Messages
643
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

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Sort by date Sort by votes
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
Leith Ross said:
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
Click to expand...
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
You must log in or register to reply here.

Similar threads

B
  • Question
populating the next available row in a shared workbook
Replies
1
Views
261
rondeondo
rondeondo
B
  • Question
Populating a worksheet based on a Combo Box value within a User Form
2 3 4
Replies
35
Views
1K
igold
igold
D
  • Question
Userform new entries
Replies
1
Views
390
Logit
Logit
A
  • Question
HOW INSERT A HYPERLINK TO A PROTECTED WORKSHEET THAT INCLUDES VBA
Replies
2
Views
366
AYSHANA
A
I
  • Question
Current Code taking 10 Hours to run. Need Help to Optimize
Replies
5
Views
253
ItalianPlatinum
I

Forum statistics

Threads
1,214,875
Messages
6,122,040
Members
449,063
Latest member
ak94

Share this page

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