FaceID ermitteln

FaceID ermitteln. Symbolleiste dynamisch erzeugen
Beispiel für die FaceIDs 0 bis 500
Sub Workbook_Open()
ActiveWindow.WindowState = xlMaximized
Call CreateFormBar
frmFaceID.Show
End Sub
Formular:
Private Sub cmdFaceId_Click()
Dim strDefaultStatus As String
Set up global variables with current requested values
glbLastFirstID = txtFirstID
glbLastLastID = txtLastID
Detect current status bar value
Set status bar message while FaceIds are generated
strDefaultStatus = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Working on FaceID display please wait"
Call validation procedure
Call Validate
Put Status bar back as it was
Application.DisplayStatusBar = False
Application.StatusBar = strDefaultStatus
End Sub
Private Sub txtFirstID_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Test for non numeric entry then cancel or convert to long
If IsNumeric(txtFirstID) = False Then
txtFirstID = ""
Cancel = True
Else
txtFirstID = CLng(txtFirstID)
End If
End Sub
Private Sub txtLastID_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Test for non numeric entry then cancel or convert to long
If IsNumeric(txtLastID) = False Then
txtLastID = ""
Cancel = True
Else
txtLastID = CLng(txtLastID)
End If
End Sub
Private Sub UserForm_Activate()
Set up form with last requested values
Make toolbar not visible
On Error Resume Next
txtFirstID = glbLastFirstID
txtLastID = 500 glbLastLastID
Application.CommandBars("ShowForm").Visible = False
End Sub
Private Sub UserForm_Terminate()
Show toolbar if form is unloaded in
Validate procedure of if X is clicked
On Error Resume Next
Application.CommandBars("ShowForm").Visible = True
End Sub
Private Sub cmdClose_Click()
Unload frmFaceID
End Sub
Modul:
Global variables hold previous choices for beginning and ending FaceID numbers
Public glbLastFirstID As Long
Public glbLastLastID As Long
Function CBShowButtonFaceIDs(lngIDStart As Long, lngIDStop As Long)
This procedure creates a toolbar with buttons that display the images
associated with the values starting at lngIDStart and ending at lngIDStop
Dim cbrNewToolbar As CommandBar
Dim cmdNewButton As CommandBarButton
Dim intCntr As Integer
Delete existing ShowFaceIds toolbar if it exists
On Error Resume Next
Application.CommandBars("ShowFaceIds").Delete
frmFaceID.MousePointer = fmMousePointerHourGlass
Create a new toolbar
Set cbrNewToolbar = Application.CommandBars.Add _
(Name:="ShowFaceIds", temporary:=True)
Create a new button with an image matching the FaceId property value indicated by intCntr
For intCntr = lngIDStart To lngIDStop
Set cmdNewButton = cbrNewToolbar.Controls.Add(Type:=msoControlButton)
cbrNewToolbar.Width = 800
cbrNewToolbar.Left = 100
cbrNewToolbar.Top = 200
cbrNewToolbar.Visible = True
With cmdNewButton
Setting the FaceId property value specifies the appearance but not the functionality of the button
.FaceId = intCntr
.Caption = "FaceId = " & intCntr
End With
Show the images on the toolbar
With cbrNewToolbar
.Width = 800
.Left = 100
.Top = 200
.Visible = True
End With
Next intCntr
frmFaceID.MousePointer = fmMousePointerDefault
End Function
Public Function Validate()
Dim lngTempNumber As Long
Procedure to check data entered by user
With frmFaceID
If the first number requested < last number then reverse them and rationalize display next time form opens
If .txtFirstID Or .txtLastID > 0 Then
If CLng(.txtFirstID) > CLng(.txtLastID) Then
lngTempNumber = .txtFirstID
.txtFirstID = .txtLastID
.txtLastID = lngTempNumber
glbLastFirstID = .txtFirstID
glbLastLastID = .txtLastID
End If
If (.txtLastID - .txtFirstID) <= 500 Then
Call procedure to create FaceID values
Call CBShowButtonFaceIDs(.txtFirstID, .txtLastID)
Unload frmFaceID
Else
Only allow 200 FaceIDs per operation
MsgBox "Please request less than 500 FaceIDs ", , "FaceID Number Finder"
End If
Else
.txtFirstID.SetFocus
End If
End With
End Function
Public Function CleanUp()
On Error Resume Next
Application.CommandBars("ShowFaceIds").Delete
Application.CommandBars("ShowForm").Delete
End Function
Public Function CreateFormBar()
Dim cmdBar As CommandBar
Dim btnForm As CommandBarButton
Delete the object if it already exists
On Error Resume Next
Application.CommandBars("ShowForm").Delete
Set the commandbar object variable
Set cmdBar = Application.CommandBars.Add
cmdBar.Name = "ShowForm"
Add a button
With cmdBar.Controls
Set btnForm = .Add(msoControlButton)
End With
Set the new buttons properties
With btnForm
.Style = msoButtonIconAndCaption
.Caption = "Show FaceId Finder Form"
.FaceId = 2104
.OnAction = "OpenForm"
.TooltipText = "Show FaceID Form"
End With
Made visible in the form terminate event
End Function
Public Function OpenForm()
OnAction event procedure of ShowForm toolbar
frmFaceID.Show
End Function
Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt