Discussione: Corso VBA
Visualizza messaggio singolo
Vecchio 08-09-2014, 00.22.38   #58
Alexsandra
Senior Member
WT Expert
 
L'avatar di Alexsandra
 
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.208
Alexsandra  un gioiello raroAlexsandra  un gioiello raroAlexsandra  un gioiello raroAlexsandra  un gioiello raro
#5

Macro e Procedure varie riferite alle Userform


=> Link email in una Userform
Codice:
Private Sub email_lnk_Click()
Link = "mailto:president@italy.gov"
On Error GoTo No_Sped
ActiveWorkbook.FollowHyperlink Address:=Link, NewWindow:=True
Unload Me
Exit Sub
No_Sped:
MsgBox "Impossibile aprire" & Link
End Sub
=> Link sito web in una Userform
Codice:
Private Sub web_lnk_Click()
Link = "http://www.italy.gov"
On Error GoTo No_Sped
ActiveWorkbook.FollowHyperlink Address:=Link, NewWindow:=True
Unload Me
Exit Sub
No_Sped:
MsgBox "Impossibile aprire" & Link
End Sub
=> Disabilita la x di chiusura in una form
Codice:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Cancel = vbNo
MsgBox "Per uscire devi cliccare su [ Esci dal Programma ]"
End Sub

=> Avviare una macro una volta sola
Nota: Eseguire una macro una volta sola e poi la procedura viene cancellata.
Codice:
Private Sub Workbook_Open()
Dim Lin_In, Lin_Fi
Msg = "La procedura Workbook Open e terminata "
ActiveSheet.Range("A1").Value = Msg
With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
  Lin_In = .ProcStartLine("Workbook_Open", 0)
  Lin_Fi = .ProcCountLines("Workbook_Open", 0)
   .DeleteLines Lin_In, Lin_Fi
End With
End Sub
=> Eseguire una macro quando una userform attiva
Codice:
sub Form_V()
If UserForm1.Visible = True Then
MsgBox "Buongiormo" 'Macro1
Else MsgBox "Arrivederci" 'Macro2
End If
end sub
=> Chiudere una Userform dopo cinque secondi
Codice:
Private Sub UserForm_Activate()
    Application.OnTime Now + TimeValue("00:00:5"), "Chiude"
End Sub

Private Sub UserForm_Initialize()
    Label1.Caption = "Active sheet: " & ActiveWorkbook.ActiveSheet.Name
End Sub

Private Sub CommandButton1_Click()
    UserForm1.Hide
End Sub

' E in un modulo standard inserire 
Sub chiude()
UserForm1.Hide
End Sub
=> Formato del testo in un listbox
Codice:
ListBox1.Font.Name = "Calibri"
ListBox1.Font.Italic = True
ListBox1.Font.Size = 12
=> Ridurre finestra
Nota: Copiare il codice nel Workbook in cui volete ridurre la finestra, cos all'apertura, la finestra sar sempre piccola. Autore: Marco Gamberini
Codice:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveWindow.WindowState = xlMaximized
End Sub

Private Sub Workbook_Open()
ActiveWindow.WindowState = xlMinimized
End Sub
=> Visualizzare una userform a tutto schermo
Nota: Una macro per visualizzare una Userfom, senza vedere Excel. Autore N. Jones
Codice:
Private Sub Workbook_Open()
'Nel modulo ThisWorkbook
UserForm1.Show
End Sub

Private Sub UserForm_Initialize()
'Nel modulo dell'Userform
With Application
.Visible = False
Me.Top = .Top
Me.Left = .Left
Me.Height = .Height
Me.Width = .Width
End With
End Sub

Private Sub UserForm_Terminate()
With Application
.Visible = True
End With
End Sub
=> Scegliere dove far comparire una Userform
Nota : Permette di imporre dove fare comparire un userform e di non potere spostarlo
Codice:
Private Sub UserForm_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
UserForm1.Left = 100
UserForm1.Top = 100
End Sub
=> Posizionare una Userform a destra dello schermo
Commento : Permette di postare la Userform su un lato dello schermo Autore: M. Pierron
Codice:
Sub Visalizza()
With UserForm1
.StartUpPosition = 0
.Left = Application.UsableWidth - .Width
.Top = Application.UsableHeight - .Height
.Show
End With
End Sub
=> Testo scorrevole in una userform
Commento : Permette, dopo avere creato un oggetto label, di fare sfilare un testo sull'userform Autore : Herv
Codice:
 Private Declare Function GetTickCount Lib "Kernel32" () As Long
Public Fermare As Boolean
Dim Testo As String

Public Sub Crono()
Dim Top As Long
Do
If Fermare = True Then Exit Do
Top = GetTickCount()
Do While GetTickCount() < Top + 70
DoEvents
Loop
DoEvents
Messaggio
DoEvents
Loop
End Sub

Sub Messaggio()
Dim Testo1 As String, Testo2 As String
With Label1
Testo2 = Left(.Caption, Len(Testo) - Len(.Caption) + 1)
Testo1 = Right(.Caption, Len(.Caption) - 1) & Testo2
.Caption = Testo1
End With
End Sub

Private Sub UserForm_Activate()
Crono
End Sub
Private Sub UserForm_Click()
Fermare = Not Fermare
End Sub

Private Sub UserForm_Initialize()
Testo = "Questo  un esempio " & _
"di messaggio scorrevole " & _
"inserito in una Userform !" & Space(5)
With Label1
.Caption = Testo
.Font.Bold = True
End With
End Sub
=> Formato testo in un Textbox
Codice:
'La data 01/01/2001 :
TextBox1.Value = Format(TextBox1.Value, "dd/mm/yyyy")

'Un numero 1 251:
TextBox2.Value = Format(TextBox2.Value, "#,##0.00 [$?-40C]")

'Un numero di telefono : 02 04 55 55 55
TextBox3.Value = Format(TextBox3.Value, "00"" ""00"" ""00"" ""00"" ""00")
___________________________________

- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale -
Alexsandra non  collegato