supprimer la croix rouge d'un usf

[noviceAG]

Bonjour le Forum,
Après recherche sur le sujet, j'ai trouvé des réponses mais aucune ne fonctionne
Je suis sous Excel 2003 et très novice en la matière
En vous remerciant de vos réponses bien détaillées

 

[jeanpierre]

Re : supprimer la croix rouge d'un usf

Bonsoir novice AG, le forum,

Pourquoi ? question....

C'est un peu comme un bouton "Annuler", donc on ne fait rien.

Toucher aux fondamentaux d'Excel, moi je ne le ferai pas.... et surtout pour un "novice"....

Je te souhaite bonne soirée ou nuit maintenant.

Jean-Pierre

 

[fred65200]

Re : supprimer la croix rouge d'un usf

bonjour,

le code suivant empêche la fermeture du USF avec la croix rouge.

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode <> 1 Then Cancel = 1
End Sub
'prévois un bouton pour fermer
Private Sub CommandButton1_Click()
Unload Me
End Sub

cordialement

 

[noviceAG]

Re : supprimer la croix rouge d'un usf

Bonjour jeanpierre, fresd65200,
Je m'explique, j'ai une appli dont je souhaite mettr un message d'attent pendant une exécution plus ou moins longue du code
J'ai donc envisager d emettre un message d'attent via un usf (éviter d'être obliger de valider pour un MsgBox) au début d'exécution du code, puis de fermer l'usf à la fin
J'ai trouvé pour afficher l'usf avec ceci :

Private Declare Function GetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub UserForm_Initialize()
Dim hwnd As Long
hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", _
"X", "D") & "Frame", Me.Caption)
SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
End Sub

Par contre, je n'arrive pas à fermer ce dit usf
En vous remerciant de bien vouloir éclairer ma lanterne

 

[fred65200]

Re : supprimer la croix rouge d'un usf

bonsoir,

pour fermer l'usf

Unload UserForm1 'ou Me

@+

 

[noviceAG]

Re : supprimer la croix rouge d'un usf

dans un module ou sur la feuille ?

 

[fred65200]

Re : supprimer la croix rouge d'un usf

re
a la fin de ton code avec le bon nom de Usf.
En fait au moment où tu veux qu'il disparaisse.

 

[noviceAG]

Re : supprimer la croix rouge d'un usf

Merci fred65200,
Je viens d'essayer mais ce ne fonctionne pas
Voici ce que j'ai sur l'usf :
Private Declare Function GetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub Usf1_Show()
Dim hwnd As Long
hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", _
"X", "D") & "Frame", Me.Caption)
SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
End Sub

Private Sub Usf1_Fermer()
Unload Usf1 'ou Me
End Sub

Dans un module :
Private Sub Usf1_Fermer()
Unload Usf1 'ou Me

Bien sur en faisant l'un ou l'autre (feuille ou module)
Merci de me dire ce que je foire
End Sub

 

[fred65200]

Re : supprimer la croix rouge d'un usf

re

je pensais que tu lançais un USF

sub TaMacro
Usf1.show 0
'..............
'Ton code
'..............
unload Usf1
end sub

sinon, comment mets tu ton message d'attente?
EDIT
le code dans un module, retire le Private
cordialement

 

[Banzai64]

Re : supprimer la croix rouge d'un usf

Bonjour

A mon avis tu te compliques la vie

Dans l'éditeur VBA menu : Insertion --> Userform

En principe il va s'appeler Userform1

ensuite dedans tu rajoutes ce que tu veux (TextBox, ComboBox etc ..)

Pour l'afficher

Userform1.Show


Pour l'enlever

Unload Userform1

 

[noviceAG]

Re : supprimer la croix rouge d'un usf

Bonjour Michel,
Je pense que tu vas comprendre en voyant ceci :

Bonsoir Spitolan08,
voici le code sur l'usf :

Private Declare Function GetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub Usf1_Initialize()
Dim hwnd As Long
hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", _
"X", "D") & "Frame", Me.Caption)
SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
End Sub

Private Sub Usf1_Fermer()
Unload Usf1 'ou Me
End Sub


Le code dans un module :

Sub VerifStock()
Dim Diko As Object ' Je vais stocker le nom des feuilles à traiter
Dim CurCel As Range ' Cellule contenant le nom que je cherche
Dim CurTrouve As Range ' Cellule contenant le nom trouvé
Dim Forme As Shape ' Ma boîte d'attente

Dim FDep As String ' Feuille en cours
Dim FFin As String ' Feuille pour évaluer le stock
Dim Ws As Worksheet ' Pour manipuler aisément les feuilles du classeur

Usf1.Show
Call EffVerifStock
Set Diko = CreateObject("Scripting.Dictionary")
For Each CurCel In [A_Traiter] ' Scrute la plage nommée
If CurCel = "" Then Exit For ' Je suis au bout de la liste
Diko.Add UCase(CurCel.Value), UCase(CurCel.Value) ' Passe tout en majuscules : Moins de tracas
Next CurCel

If Diko.Count = 0 Then Exit Sub ' Si pas de feuilles à traiter je quitte


FFin = "Cde"
Set CurCel = Sheets(FFin).Range("B15")
Sheets(FFin).Range("G15:K" & Range("B65536").End(xlUp).Row).ClearContents
While CurCel <> "" ' Tant que l'on a quelque chose à chercher
For Each Ws In ThisWorkbook.Sheets ' Je regarde toutes les feuilles du classeur
If Diko.Exists(UCase(Ws.Name)) Then ' Feuille dans la liste donc je cherche
FDep = Ws.Name
With Sheets(FDep).Range("H2:IV2") ' Sur toute la ligne 2
Set CurTrouve = .Find(CurCel, LookIn:=xlValues, lookat:=xlWhole)
If Not CurTrouve Is Nothing Then ' Trouvé
If CurCel.Offset(0, 6) <> "" Then ' Déjà inscrit un nom de page
Cells(CurCel.Row, Range("IV" & CurCel.Row).End(xlToLeft).Column + 1) = Ws.Name
Else
CurCel.Offset(0, 6) = Ws.Name ' C'est le premier que j'inscrit
End If
Set CurTrouve = CurTrouve.Offset(-1, 0) ' Avec ces ###Grrr@@@ cellules fusionnées
CurCel.Offset(0, 5) = CurCel.Offset(0, 5) + CurTrouve.Offset(0, 3)
End If
End With
End If
Next Ws
Set CurCel = CurCel.Offset(1, 0) ' Se positionne sur la prochaine cellule à vérifier
Wend
Unload Usf1
End Sub

Je te remerci de me corriger

 

[news]

Re : supprimer la croix rouge d'un usf

Bonjour à tous du forum,

re: supprimer la croix rouge d'un usf

essaie avec le code suivant dans USF pour supprimer la croix dans USF

Me.StartUpPosition = 2 'put the userform in center of screan
Dim hWnd As Long
hWnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", _
"X", "D") & "Frame", Me.Caption)
SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) And &HFFF7FFFF

' ===== on va récupérer le handle de la form =====
Dim MeHwnd As Long
MeHwnd = FindWindowA(vbNullString, Me.Caption)