VBA/Excel/Access/Word/Forms/Form

Материал из VB Эксперт
Версия от 12:48, 26 мая 2010; Admin (обсуждение | вклад) (1 версия)
(разн.) ← Предыдущая | Текущая версия (разн.) | Следующая → (разн.)
Перейти к: навигация, поиск

Adding Controls to a UserForm at Design Time

 
Sub RunTimeButton()
    Dim Butn As CommandButton
    Set Butn = UserForm1.Controls.Add("Forms.rumandButton.1")
    With Butn
        .Caption = "Added at runtime"
        .Width = 100
        .Top = 10
    End With
    UserForm1.Show
End Sub



Cancels a cancelable event (an event that has a Cancel parameter).

 
Private Sub Form_BeforeUpdate(Cancel As Integer)
   If MsgBox("Are you sure you want to save changes to this record?", _
              vbYesNo Or vbInformation, "Confirm Upate") = vbNo Then
      DoCmd.CancelEvent
   End If
End Sub



Change caption

 
Sub ChangeCaption(frmAny As Form)
   If IsNull(frmAny.Caption) Then
      frmAny.Caption = "Form For - " & CurrentUser
   Else
      frmAny.Caption = frmAny.Caption & " - " & CurrentUser
   End If
End Sub



Close a form

 
Private Sub cmdClose_Click()
   
   DoCmd.Close acForm, Me.Name
    
End Sub



Creating UserForms Programmatically

 
Sub MakeForm()
    Dim TempForm As Object
    Dim NewButton As Msforms.rumandButton
    Dim Line As Integer
    Application.VBE.MainWindow.Visible = False
    Set TempForm = ThisWorkbook.VBProject. _
      VBComponents.Add(3) "vbext_ct_MSForm
    With TempForm
        .Properties("Caption") = "Form"
        .Properties("Width") = 200
        .Properties("Height") = 100
    End With
    Set NewButton = TempForm.Designer.Controls _
      .Add("forms.rumandButton.1")
    With NewButton
        .Caption = "Click Me"
        .Left = 60
        .Top = 40
    End With
    With TempForm.CodeModule
        Line = .CountOfLines
        .InsertLines Line + 1, "Sub CommandButton1_Click()"
        .InsertLines Line + 2, "  MsgBox ""Hello!"""
        .InsertLines Line + 3, "  Unload Me"
        .InsertLines Line + 4, "End Sub"
    End With
    VBA.UserForms.Add(TempForm.name).Show
    ThisWorkbook.VBProject.VBComponents.Remove TempForm
End Sub



Display form in Modal mode

 
Sub cmdGetUserForm_Click()
    frmStats.Show vbModal
End Sub



Format fonts

 
Sub PermanentFormFonts (strFont As String)
    On Error GoTo PermanentFormFonts_Err
    Dim objAO        As AccessObject 
    Dim objCP        As Object       
    Dim ctlControl    As Control     
    Set objCP = Application.CurrentProject
    For Each objAO In objCP.AllForms
        DoCmd.OpenForm objAO.Name, acDesign, , , , acHidden
        For Each ctlControl In objAO.Controls
            ctlControl.FontName = strFont
        Next
        DoCmd.Close acForm, objAO.Name, acSaveYes
    Next
PermanentFormFonts_Exit:
    Exit Sub
PermanentFormFonts_Err:
    If Err.Number = 438 Then
        Resume Next
    Else
        MsgBox Err.Description
        Resume PermanentFormFonts_Exit
    End If
End Sub



Form count

 
Sub exaFormsContainer()
    Dim db As Database
    Dim frm As Form
    Dim doc As Document
    
    Set db = CurrentDb
    
    Debug.Print "Opened form count: " & Forms.Count
    For Each frm In Forms
        Debug.Print frm.Name
    Next
    Debug.Print "Saved form count: " & db.Containers!Forms.Documents.Count
    For Each doc In db.Containers!Forms.Documents
        Debug.Print doc.Name
    Next
End Sub



Loading a Form into Memory Prior to Displaying It

 
Sub ModifySimpleForm() 
    Dim sNewCaption As String 
    Load frmSimpleForm 
    sNewCaption = InputBox("Enter a caption for the form.") 
    frmSimpleForm.Caption = sNewCaption 
    frmSimpleForm.Show 
    MsgBox "OK - same form again except with default caption", vbOKOnly 
    frmSimpleForm.Show 
End Sub



Open a form, format the fonts and close it

 
Sub PermanentFormFonts (strFont As String)
    Dim objAO        As AccessObject  
    Dim objCP        As Object        
    Dim ctlControl    As Control      
    Set objCP = Application.CurrentProject
    For Each objAO In objCP.AllForms
        DoCmd.OpenForm objAO.Name, acDesign, , , , acHidden
        For Each ctlControl In objAO.Controls
            ctlControl.FontName = strFont
        Next
        DoCmd.Close acForm, objAO.Name
    Next
End Sub



Output form to html file

 
Sub OutputToDAP()
    DoCmd.OutputTo acOutputForm, "frmComplaints", acFormatDAP, "c:\P.html"
End Sub



To remove the Userform from the computer"s memory, you must use the Unload statement; otherwise, the Userform is only hidden.

 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Unload Me     "Removes Userform named frmStats from memory.
End Sub



Using the Show Method to Display a Form

 
Sub SimpleFormExample() 
    ShowSimpleForm True 
    MsgBox "OK - Same form now, but modeless.", vbOKOnly 
    ShowSimpleForm False 
    MsgBox "Exiting the SimpleFormExample procedure.", vbOKOnly 
End Sub 
Private Sub ShowSimpleForm(bModal As Boolean) 
    If bModal Then 
        frmSimpleForm.Show vbModal 
    Else 
        frmSimpleForm.Show vbModeless 
    End If 
End Sub