Fenêtre automatique

**ericdu06** · 05/06/2016, 19h28

Bonjour,

Je vous propose un nouvel élément à utiliser : Fenêtre automatique

Bonjour

Je souhaiterai partager ce petit bout de programme excel qui vous facilitera la saisie de basse de donnée.

Un userform avec une listbox alimenté par votre bd et autan de textbox qu'il y as de colonnes.

Un petit mode d'emplois ce trouve dans l'userform lui même.

Un bon exemple sur l'utilisation d'un userform (afficher,rechercher,modifier,créer) , sur les variables tableau,les recherches et calendrier ext...

Qu'en pensez-vous ?

**kiki29** · 05/06/2016, 19h36

Salut, ton fichier téléchargé apparait sans extension ( normalement xlsm ).

**ericdu06** · 05/06/2016, 19h59

Bonjour, je ne comprend pas pourquoi il est a la mauvaise extension .
J'ai essayé de l'ouvrir via le forum et j'ai réussi. Dans la fenêtre ouvrir avec, il faut sélectionner Excel
Merci

**kiki29** · 06/06/2016, 01h34

Re, c'est en fait un problème récurrent et pas systématique sur ce forum, maintes fois signalé et jamais résolu à ce jour.

**patricktoulon** · 07/06/2016, 10h07

Bonjour
pas mal du tout
néanmoins il y a quelques détails que tu pourrais corriger

1°les largeurs de colonne de la liste box
la limite a 17 colonne c'est assez rédhibitoire dans le sens ou a partir du moment ou tu utilise une classe control tu peut la faire automatique en terme de nombre de colonne et sans restriction

2 le format pour les codes postal est a revoir dans la listbox (voir capture )

l'idée de la 2 eme ligne pour les format de control (en jaune ) pourrait te permettre de pouvoir créer des control dynamique ( gérés par la classe )alors que toi finalement tu t'en sert pas si ce n'est que pendant l'évènement control ou pour chargement

**ericdu06** · 07/06/2016, 18h19

Bonjour, et merci pour le retour .
J'ai corrigé quelques bug et rallongé le nombre de textbox (a 30 : mais je ne peut pas le faire a l'infini)
Dans ma prochaine version je souhaiterai inclure la recherche sur plusieurs champs (sa peut être utile)
En parlant de recherche, j'aimerai mettre un système de temporisation avant de lancer la boucle..de façon a pouvoir rechercher directement un mot ou une suite!
ça gagnerais en efficacité
Les formats, ainsi que la date qui s'inverse entre le moi et le jour on été corrigé.

"l'idée de la 2 eme ligne pour les format de control (en jaune ) pourrait te permettre de pouvoir créer des control dynamique ( gérés par la classe )alors que toi finalement tu t'en sert pas si ce n'est que pendant l'évènement control ou pour chargement "

Je ne saisi pas ! Je vais me pencher sur la solution

Merci

**patricktoulon** · 11/06/2016, 10h28

bonjour

exuse pour cette absence mais j'ai du boulot en ce moment par dessus la tète

bon je ré explique
a partir du moment ou tu utilise une ligne jaune pour déterminer le type de control tu n'est pas obligé de les mettre en dur mais plutôt de les créer dynamiquement

ensuite la limite de 17 ou même de 30 est plutôt boff

tu utilise des boucle for x= 1 to y
utilise plutôt des boucle for each cel in range(xy:azz)
de cette manière on a pas de limite basse ou haute en terme de controls

ensuite pour les widths de colonne de la liste box tu trouvera dans divers discution aux quelles j'ai participé
comment je les règle
encore une fois une boucle for each cel......

exemple il te serait facile d'intégrer cela dans ta classe
et comme tu peux le constater la seule limite est la plage de cellule
de cette manière c'est universel les colonnes sont ajustées et la largeur de la liste box aussi

teste ceci dans un classeur vierge et met des colonne de largeur différentes dans ta plage

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub UserForm_Activate()
Dim plage As Range,w as long 
Set plage = Range("A1:d10")
tablo = plage.Value
ListBox1.ColumnCount = plage.Columns.Count
For Each col In plage.Rows(1).Cells
thewidth = thewidth & Round(col.ColumnWidth) * 4.5 & ";": w = w + Round(col.ColumnWidth) * 5
Next
ListBox1.ColumnWidths = Mid(thewidth, 1, Len(thewidth) - 1):ListBox1.List = plage.Value:ListBox1.Width = w
Debug.Print thewidth
End Sub

et pour les controls dynamiques avec userform1.controlsadd....... dans la même boucle for each (la rows(1) étant la ligne des entêtes de ta plage )et pour le type de control se serait col.offset(1,0)qui nous donne la cellule en jaune et donc le type de control

je te ferait un exemple la semaine prochaine sa devrait être plus calme au boulot

**ericdu06** · 15/06/2016, 18h56

Bonjour Patrick

Merci pour tes conseilles, qui me sont précieux
J'ai testé le code dans un classeur vierge, c'est pas mal du tout
Je vais faire un mixte et incorporé ce code.
Pour la limite c'est plutôt une question d’esthétique et de taille de l'userform, mais tu as raison ce n'est pas top
Peut être la solution serais des onglets, mais je veut que sa reste simple..mais l'important c'est que toutes les données soient accessible

A bientôt.

**kiki29** · 15/06/2016, 21h32

Bonjour les poètes : Antidote d'urgence .

**ericdu06** · 16/06/2016, 19h53

J'ai posté une mise a jour plus stable, et les recherches multicritères son actifs.

**ericdu06** · 15/09/2016, 19h25

Bonjour a tous,
Voici une nouvelle mise a jour
2016.09.15

A bientôt.

**www.ptvc.ch** · 15/02/2019, 23h55

bonjour

j'ai trouve votre petit petit programme génial et j'ai déjà passe quelque heure, pourriez vous rajouter un autre petit bou de code

j'ai besoin une colonne avec les heures et la possibilité qu'il aie chercher une photo qui se trouve dans un fichier photo en raport avex une collone ou est indiquer le nom de la photo

**kagatg** · 04/06/2019, 01h34

Bonjour
Lors du lancement de la fenêtre automatique, il indique une erreur: "erreur de compilation ……. le code contenu dan ce projet doit etre mis à jour pour pouvoir etre utilisé sue les systèmes 64 bits. Vérifiez et mettez à jour les instructions Declare puis marquez les avec l'atribut ptrsafe"

**solar94** · 08/03/2022, 20h47

Bonjour

désolé de déterrer ce sujet mais ce programme m'a séduit pour mes débuts. Cependant quand je clique sur lancer la fenêtre automatique et j'essaie d'entrer une donnée sur l'userform j'ai le débogueur qui se lance en m'indiquant

erreur de compilation incompatibilité de type

puis en surbrillance dans le code VBA dans le Module 2 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Public Sub Lance_Timer()
 
AddressOf TimerProc

Impossible d'aller plus loin.

Merci de vos contributions.

**Pierre Fauconnier** · 09/03/2022, 16h59

Salut.

Contribution mal torchée, mal écrite, non maintenable...

(pas de Option Explicit, variables publiques en veux-tu en voilà, ...)

Pour adapter à un 64bits, il faut modifier plusieurs choses:

Dans le module 2, remplacer toutes les lignes avant la proc TimerProc par ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
'Les API
#If VBA7 Then
      Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, _
            ByVal lpTimerFunc As LongPtr) As LongPtr
      Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As LongPtr) As LongPtr
#Else
      Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, _
            ByVal lpTimerFunc As Long) As Long
      Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If
 
'variables globales
      Public iCounter As Integer
#If VBA7 Then
  Public lngTimerID As LongPtr
#Else
  Public lngTimerID As Long
#End If
      Public BlnTimer As Boolean

Dans le module Calendrier1, remplacer ce qui se trouve avant la ligne Private Type InitCommonControlsExType par ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Option Explicit
#If VBA7 Then
  Private Declare PtrSafe Function FindWindow& Lib "user32" _
      Alias "FindWindowA" _
      (ByVal lpClassName$, ByVal lpWindowName$)
  Private Declare PtrSafe Function ScreenToClient& Lib "user32" _
      (ByVal hwnd&, ByRef lpPoint As POINTAPI)
  Private Declare PtrSafe Function GetWindowRect& Lib "user32" _
      (ByVal hwnd&, lpRect As RECT)
  Private Declare PtrSafe Function CreateWindowEx& Lib "user32" _
      Alias "CreateWindowExA" _
      (ByVal dwExStyle&, ByVal lpClassName$, ByVal lpWindowName$, _
      ByVal dwStyle&, ByVal x&, ByVal y&, ByVal nWidth&, _
      ByVal nHeight&, ByVal hWndParent&, ByVal hMenu&, _
      ByVal hInstance&, ByRef lpParam As Any)
  Private Declare PtrSafe Function InitCommonControlsEx& Lib "comctl32" _
      (ByRef INITCOMMONCONTROLSEXData As InitCommonControlsExType)
  Private Declare PtrSafe Function DestroyWindow& Lib "user32" _
      (ByVal hwnd&)
  Private Declare PtrSafe Function SendMessage& Lib "user32" _
      Alias "SendMessageA" _
      (ByVal hwnd&, ByVal wMsg&, ByVal wParam&, ByRef lParam As Any)
  Private Declare PtrSafe Function SetWindowPos& Lib "user32" _
      (ByVal hwnd&, ByVal hWndInsertAfter&, ByVal x&, _
      ByVal y&, ByVal cx&, ByVal cy&, ByVal wFlags&)
#Else
  Private Declare Function FindWindow& Lib "user32" _
      Alias "FindWindowA" _
      (ByVal lpClassName$, ByVal lpWindowName$)
  Private Declare Function ScreenToClient& Lib "user32" _
      (ByVal hwnd&, ByRef lpPoint As POINTAPI)
  Private Declare Function GetWindowRect& Lib "user32" _
      (ByVal hwnd&, lpRect As RECT)
  Private Declare Function CreateWindowEx& Lib "user32" _
      Alias "CreateWindowExA" _
      (ByVal dwExStyle&, ByVal lpClassName$, ByVal lpWindowName$, _
      ByVal dwStyle&, ByVal x&, ByVal y&, ByVal nWidth&, _
      ByVal nHeight&, ByVal hWndParent&, ByVal hMenu&, _
      ByVal hInstance&, ByRef lpParam As Any)
  Private Declare Function InitCommonControlsEx& Lib "comctl32" _
      (ByRef INITCOMMONCONTROLSEXData As InitCommonControlsExType)
  Private Declare Function DestroyWindow& Lib "user32" _
      (ByVal hwnd&)
  Private Declare Function SendMessage& Lib "user32" _
      Alias "SendMessageA" _
      (ByVal hwnd&, ByVal wMsg&, ByVal wParam&, ByRef lParam As Any)
  Private Declare Function SetWindowPos& Lib "user32" _
      (ByVal hwnd&, ByVal hWndInsertAfter&, ByVal x&, _
      ByVal y&, ByVal cx&, ByVal cy&, ByVal wFlags&)
#End If

Après, ça compile se ça s'ouvre...

**solar94** · 09/03/2022, 18h53

Merci mais le problème persiste ..

.sub, Function ou Proprety attendue

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
'La procédure de commencement du Timer
      Public Sub Lance_Timer()
        '200 = intervalle en millisecondes
        'TimerProc = Coucou
        lngTimerID = SetTimer(0, 0, 200, AddressOf TimerProc)
        If lngTimerID = 0 Then
            MsgBox "Timer non créé. Fin du programme."
            Exit Sub
        End If
        BlnTimer = True
      End Sub

**Pierre Fauconnier** · 09/03/2022, 19h50

Il ne sert à rien de nous balader sur excel pratique. Si c'est le même fichier que celui d'origine.

J'ai corrigé celui d'origine, je ne vais pas m'amuser à corriger une deuxième fois un autre fichier. En plus, un beau Exit Sub...

sur quelle ligne as-tu cette erreur?

**solar94** · 09/03/2022, 20h07

Je comprends parfaitement aussi pourriez vous me mettre en lien le fichier corrigé ?

C'est sur la ligne : Public Sub Lance_Timer() qui est en subrillance

Cordialement

**Pierre Fauconnier** · 09/03/2022, 20h24

Le voici

**solar94** · 09/03/2022, 21h32

MERCI BEAUCOUP....j'avais donc le mauvais fichier.

Merci. Bonne soirée.

Fenêtre automatique

Macros et VBA Excel

Discussions similaires

Partager

Partager