| Symbolleiste dynamisch erzeugen | |
| |
| |
| Beispiel für die FaceIDs 0 bis 500 | |
 | |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| Sub Workbook_Open() | |
| ActiveWindow.WindowState = xlMaximized | |
| Call CreateFormBar | |
| frmFaceID.Show | |
| End Sub | |
| |
 | |
| |
| |
| |
| |
| |
| |
| |
| 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 | |
| |
zurück