Buongiorno a tutti.
Alcuni giorni fa ho impostato una userform che mi si apre a schermo intero all'apertura del file excel.
I codici impostati sono i seguenti:
CARTELLA DI LAVORO:
Option Explicit
Private Sub Workbook_Open()
UserForm2.Show vbModal
End Sub
USERFORM2:
Option Explicit
Private Const mcstrFoglio As String = "Foglio1"
Private Const mcstrStart As String = "A4"
Private Const mcstrStop As String = "A81"
Private Const mcstrColST_ As String = "A"
Private Const mcstrColOgg As String = "B"
Private Const mcstrColRFR As String = "C"
Private Const mcstrColOwn As String = "D"
Private Const mcstrColApp As String = "E"
Private Const mcstrColAmb As String = "G"
Private Const mcstrColDat As String = "H"
Private Const mcstrColNot As String = "L"
Private mblnQuitOnClose As Boolean
Private Sub cmdInserisci_Click()
On Error GoTo ExtP
Dim wbk As Excel.Workbook
Dim wsh As Excel.Worksheet
Dim r As Long
Dim ctl As MSForms.Control
Dim bOK As Boolean
With Me
bOK = Len(.txtST.Text) > 0 _
And Len(.txtoggetto.Text) > 0 _
And .cboowner.Value <> vbNullString _
And .cboapplicativo <> txtST _
And .cboambiente.Value <> vbNullString _
And .cbodata.Value <> vbNullString _
If Not bOK Then
Call MsgBox(Prompt:="Non hai compilato tutti i campi obbligatori", _
Buttons:=vbCritical, _
Title:="ATTENZIONE")
Exit Sub
End If
End With
Set wbk = Excel.Application.ThisWorkbook
Set wsh = wbk.Worksheets(mcstrFoglio)
With wsh
r = .Range(mcstrStop).End(xlUp).Row + 1
If r = .Range(mcstrStart).Row Then
MsgBox "L'area dati è piena.", _
vbOKOnly Or vbExclamation, _
"Inserisci"
Else
.Range(mcstrColST_ & r).Value = Me.txtST.Value
.Range(mcstrColOgg & r).Value = Me.txtoggetto.Value
.Range(mcstrColRFR & r).Value = Me.txtRFR.Value
.Range(mcstrColOwn & r).Value = Me.cboowner.Value
.Range(mcstrColApp & r).Value = Me.cboapplicativo.Value
.Range(mcstrColAmb & r).Value = Me.cboambiente.Value
.Range(mcstrColDat & r).Value = Me.cbodata.Value
.Range(mcstrColNot & r).Value = Me.txtnote.Value
End If
End With
With Me
For Each ctl In .Controls
With ctl
If TypeName(ctl) = "CommandButton" Then
If ctl Is Me.cmdNew Then
.Enabled = True
.SetFocus
End If
Else
.Enabled = False
End If
End With
Next
.cmdInserisci.Enabled = False
End With
ExtP:
With Err
If .Number Then MsgBox .Description, _
vbOKOnly Or vbCritical, _
"ERRORE#" & .Number
End With
On Error Resume Next
Set ctl = Nothing
Set wsh = Nothing
Set wbk = Nothing
End Sub
Private Sub cmdNew_Click()
Dim ctl As MSForms.Control
With Me
For Each ctl In .Controls
With ctl
If TypeName(ctl) = "CommandButton" Then
If ctl Is Me.cmdInserisci Then .Enabled = True
Else
Select Case TypeName(ctl)
Case "ComboBox", "TextBox"
.Enabled = True
.Value = Null
Case "Label"
.Enabled = True
Case Else
' DO NOTHING
End Select
End If
End With
Next
.cmdNew.Enabled = False
.txtST.SetFocus
End With
Set ctl = Nothing
End Sub
Private Sub UserForm_Initialize()
Dim rng As Excel.Range
Call deleteCaption(Me)
For Each rng In ThisWorkbook.Worksheets("Foglio1").Range("Z83:Z89")
Me.cbodata.AddItem VBA.FORMAT$(rng.Value, "dd mmmm yyyy")
Next
Set rng = Nothing
With Me
.BorderStyle = fmBorderStyleSingle
End With
'interrompo eventuali Alert e ridimensiono
'a tutto schermo il file di Excel
With Application
.DisplayAlerts = False
.WindowState = xlMaximized
End With
'ridimensiono la UserForm
With Application
Me.Top = .Top
Me.Left = .Left
Me.Height = .Height
Me.Width = .Width
End With
End Sub
Private Sub cmdTEST_Click()
Unload Me
With ThisWorkbook
.Activate
.Worksheets("Foglio1").Range("U5").Select
End With
End Sub
Private Sub cmdcontrollo_Click()
Unload Me
With ThisWorkbook
.Activate
.Worksheets("Foglio1").Range("A5").Select
End With
End Sub
Private Sub cmdQuit_Click()
mblnQuitOnClose = True
Unload Me
End Sub
Private Sub UserForm_Terminate()
If mblnQuitOnClose Then
With ThisWorkbook
If Not .Saved Then .Save
.Application.Quit
End With
End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 'Disabilita la X di dx
If CloseMode = vbFormControlMenu Then
Cancel = True
End If
End Sub
Private Sub txtST_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim s As String
Dim n As Long
s = Me.txtST.Value
If Len(s) = 0 Then Exit Sub
If Len(s) <> 5 Then
Cancel = True
Else
On Error Resume Next
n = CLng(s)
If Err.Number Then Cancel = True
On Error GoTo 0
If CStr(n) <> s Then Cancel = True
End If
If Cancel Then
With Me.txtST
.SelStart = 0
.SelLength = Len(.Value)
End With
MsgBox "Immettere un numero di 5 cifre", _
vbOKOnly Or vbExclamation, _
"ATTENZIONE"
End If
End Sub
MODULO1:
Option Explicit
'--------->>
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
'--------->>
Public Sub deleteCaption(objForm As Object)
Dim lStyle As Long
Dim hMenu As Long
Dim mhWndForm As Long
If Val(Application.Version) < 9 Then
mhWndForm = FindWindow("ThunderXFrame", objForm.Caption) 'XL97
Else
mhWndForm = FindWindow("ThunderDFrame", objForm.Caption) 'XL2000+
End If
lStyle = GetWindowLong(mhWndForm, -16)
lStyle = lStyle And Not &HC00000
SetWindowLong mhWndForm, -16, lStyle
DrawMenuBar mhWndForm
End Sub
La mia esigenza è la seguente:
Quando chiudo la mia userform com faccio per far si che tramite CTRL+A mi si riapra dal mio foglio excel?
Grazie in anticipo.
Massimo
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
