Configurer un Userform

Bonjour à tous,

J'essaie de me mettre à la configuration Userform comme dans mon fichier joint destiné à publier des annonces sur les réseaux d'adoption pour des animaux maltraités.

J'ai réussi à paramétrer quelques petites choses dans le userform mais par exemple je n'arrive pas à intégrer la liste "Race"; "Sexe"; ce qui est contenu dans les ententes et les diffusions, bien entendu cela doit se remplir automatiquement dans les colonnes correspondantes de la feuille "Liste diffusion"

Si un chien est adopté, il faudrait que sa ligne se coupe et colle dans la feuille "Liste adopté", or si son statut change ou si il s'agit d'une erreur, il faudrait que sa ligne retourne dans la "Liste diffusion"

Ensuite j'aimerais paramétrer un import photo automatique, c'est à dire en cliquant sur import photo (si vous avez par exemple un logo d'appareil photo à mettre à la place du bouton, je prend), je voudrais que la photo se dimensionne et se colle dans la cellule de la colonne 2 correspondante à la ligne du chien, puis qu'un lien hypertexte se créé sur le nom du chien pour que l'on puisse accéder rapidement au dossier contenant ses photos.

Enfin, je me demande si il est possible de générer un texte en fonction des informations contenu dans la ligne correspondante à un chien, je vous met dans un fichier Exemple l'annonce type, il faudrait que le texte soit copiable/collable pour le mettre dans les annonces en ligne.

Serait-il possible d'ajouter une combo box grand format permettant la saisie du texte en commentaire et la conservation en mémoire ?

Peut-être que des choses ne seront pas possibles

Merci pour votre aide

Cordialement

23exemple.xlsx (10.80 Ko)
32fichier-asso.xlsm (153.92 Ko)

Bonjour

Il y a pas mal de choses à faire par rapport à votre demande.

J'ai réussi à paramétrer quelques petites choses dans le userform mais par exemple je n'arrive pas à intégrer la liste "Race"; "Sexe";

Votre fichier en retour pour test sur le chargement des combo dans l'USF

Evitez d'utiliser Rowsource qui pose parfois des soucis.

A vous relire

Cordialement

17fichier-asso.xlsm (134.80 Ko)

Bonjour toutes et tous,

coucou Dan

à corriger, vérifier, j'ai un doute pour la suppression des shapes (images dans liste Adoptés')

j'ai mis un bouton de command1 Active x

le code directement dans l'onglet 'Liste de diffusion'

Private Sub CommandButton1_Click()
' déclarons les variables
Dim iPR, iAV As Long
Dim PR, AV As Worksheet
Dim xPicRg, xRg As Range
Dim xPic As Shape
' on supprime les shapes et contenu de l'onglet Liste Adoptés

' en cas d'erreur on sort
On Error GoTo plouf
 With Sheets("Liste Adoptés")
    Application.ScreenUpdating = False

    Set xRg = Range("A2:P5000")

        For Each xPic In Sheets("Liste Adoptés").Shapes  '' à voir

            Set xPicRg = Range(xPic.TopLeftCell.Address & ":" & xPic.BottomRightCell.Address)
            If Not Intersect(xRg, xPicRg) Is Nothing Then xPic.Delete

        Next

    Application.ScreenUpdating = True
End With

Set PR = Worksheets("Liste diffusion")
Set AV = Worksheets("Liste Adoptés")

iAV = Range("A2").End(xlDown).Row - 1

For iPR = 2 To 65536
If PR.Cells(iPR, 13).Text = "Adopté" Then
PR.Range(iPR & ":" & iPR).Copy AV.Cells(iAV, 1)

iAV = iAV + 1

End If
Next

With Sheets("Liste diffusion")
Range("A2").Select
End With
plouf:
Exit Sub
End Sub

crdlt,

André

Bonsoir,

Merci pour votre aide

Petite question parce que ce n'est pas clair pour moi, je n'arrive pas à comprendre ce que je rate pour y arriver seul, au niveau des boutons du bas , comment insérer la croix de "validation" dans Wamiz, Faceebook, etc ?

Quand je clique sur Validation rien ne se passe

Cordialement

Re,

si cela peut t'aider, il reste des petites choses à définir

ci-joint

crdlt,

André

z60aaa
16fichier-asso-va.xlsm (224.39 Ko)

Bonjour Andre,

Je regarde ce soir et je vous fait un retour, merci beaucoup en tout cas pour l'association et les loulous

Cdlt

re,

Pour charger votre userform, utilisez le code que j'ai placé dans l'USF plutôt d'utiliser les rowsources

13fichier-asso.xlsm (127.91 Ko)

Cordialement

Edit Dan : en regardant le fichier d'André13, il faudra supprimer la macro Private Sub UserForm_Activate() si vous voulez utiliser ce que je vous propose.

@André13 : vois mon message envoyé en PRV

Bonjour toutes et tous,

@Dan

Ok, merci pour ces informations, je prends note (mp lu)

Bonjour toutes et tous,

coucou Dan

à corriger, vérifier, j'ai un doute pour la suppression des shapes (images dans liste Adoptés')

j'ai mis un bouton de command1 Active x

le code directement dans l'onglet 'Liste de diffusion'

' merci à Dan le 24/01/2019 pour les variables

Private Sub CommandButton1_Click()
' déclarons les variables
''Dim iPR, iAV As Long  ' non
''Dim PR, AV As Worksheet   ' non
''Dim xPicRg, xRg As Range  ' non
''Dim xPic As Shape  ' non
Dim iPR as long, iAV As Long  ' oui
Dim PR As Worksheet, AV As Worksheet   ' oui
Dim xPicRg as Range, xRg As Range   ' oui

' on supprime les shapes et contenu de l'onglet Liste Adoptés

' en cas d'erreur on sort
On Error GoTo plouf
 With Sheets("Liste Adoptés")
    Application.ScreenUpdating = False

    Set xRg = Range("A2:P5000")

        For Each xPic In Sheets("Liste Adoptés").Shapes  '' à voir

            Set xPicRg = Range(xPic.TopLeftCell.Address & ":" & xPic.BottomRightCell.Address)
            If Not Intersect(xRg, xPicRg) Is Nothing Then xPic.Delete

        Next

    Application.ScreenUpdating = True
End With

Set PR = Worksheets("Liste diffusion")
Set AV = Worksheets("Liste Adoptés")

iAV = Range("A2").End(xlDown).Row - 1

For iPR = 2 To 65536
If PR.Cells(iPR, 13).Text = "Adopté" Then
PR.Range(iPR & ":" & iPR).Copy AV.Cells(iAV, 1)

iAV = iAV + 1

End If
Next

With Sheets("Liste diffusion")
Range("A2").Select
End With
plouf:
Exit Sub
End Sub

crdlt,

André

crdlt,

André

Bonjour à vous,

Tout d'abord, merci à vous deux pour votre aide et votre temps, j'ai donc fusionné les deux idées

J'en ai profité pour rectifier le Userform, il y a cependant quelques soucis :

- Quand je rempli l'Userform et que je clique sur valider, les colonnes de s'incrémente pas dans la feuille "liste adoption"

- La macro de copie fonctionne bien, cependant, il n'est pas nécessaire de copier les colonnes O à S, serait-il possible que lorsque la ligne se copie vers l'autre feuille "liste adopté", la ligne se supprime dans la feuille de diffusion ?

- Savez-vous si pour l'import photo, on peut créé un lien hypertexte automatique vers le dossier du loulou ?

Merci encore pour tout

Cordialement

Re

Quand je rempli l'Userform et que je clique sur valider, les colonnes de s'incrémente pas dans la feuille "liste adoption"

Normal, il n'y a pas de code dans la Private sub validation.

Voici le code à tester (sans l'import de la photo)

Private Sub Validation_Click()
Dim dlg As Integer
With Sheets("Liste diffusion")
    dlg = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    If Nom = "" Then MsgBox "veuillez compléter un nom de chien !": Nom.SetFocus: Exit Sub
    .Range("A" & dlg) = Nom
    .Range("C" & dlg) = Sexe
    .Range("D" & dlg) = Race
    .Range("E" & dlg) = LabelDateNaiss
    .Range("F" & dlg - 1).Copy .Range("F" & dlg)
    .Range("G" & dlg) = TextBox1
    .Range("H" & dlg) = Refuge
    .Range("I" & dlg) = LabelDateArr
    .Range("J" & dlg) = Cong
    .Range("K" & dlg) = Chat
    .Range("L" & dlg) = Enfant
    .Range("M" & dlg) = Stat
    .Range("O" & dlg) = Chance
    .Range("P" & dlg) = Fonds
    .Range("Q" & dlg) = Reseau
    .Range("R" & dlg) = Wamiz
    .Range("S" & dlg) = Facebook
End With
End Sub

Question : est-ce que la validation peut se faire sans que certaines rubriques soient complétées ou quelles sont les rubriques qui doivent absolument être complétées pour que vous puissiez cliquer sur Valider.

Dans le code j'ai considéré que si pas de Nom de chien, un message est renvoyé.

Bonjour Dan,

Merci pour le code et les explication, je suis encore néophyte dans les Userform mais j'ai bien compris ce que vous avez indiqué.

Merci beaucoup

Bonsoir à tous,

Voici le fichier à jour, j'ai fais un essai, étrangement quand je clique sur validation après avoir rentré des infos, les données du loulou apparaissent mais seulement en dessous du tableau saisie à la ligne 150, et l'userform reste ouvert.

Ci-joint le fichier mis à jour

Cdlt

6fichier-asso.xlsm (163.74 Ko)

Bonjour toutes et tous,

@Fabien

à tester

Améliorations effectuées :

userform Saisie

  • Certaines Textbox(s) sont limitées à 1 ou 3 caractères (Propriété textbox MaxLenght)
  • Textbot Nom (tout en Majuscule limité à 100 caractères voir MaxLenght sur sa propriété)
  • Textbox Garot : que des chiffres (limités à 4 caractères voir propriété Maxlenght,), à voir si un point ou une virgule a lieu dans cette textbox aussi non changé le code de celui-ci)
**********

Pour la feuille 'liste diffusion'

- on arrivé à 151 car: des formules étaient présentent + des mise en page des lignes (hauteur des lignes à 50)

rectifié par suppression de contenu et effacement

Pour l'USF saisie :

  • à l'initialize de celui-ci garde le focus sur la textbox nom de mon animal (on peut modifier toujours le code sans souci bien entendu)
  • le bouton de commande de l'usf saisie 'Validation', un message box arrive pour vérifier la dernière ligne de notre feuille liste de diffusion (facile pour effectuer un repérage de la dernière ligne) on peut bien entendu supprimer ce code)

Reste à améliorer,:

après l'ajout d'une nouvelle donnée par Validation de notre usf Saisie, la mise en forme de la ligne (hauteur à 50 par défaut)

ci-joint,

Crdlt,

André

Bonsoir André,

Merci beaucoup pour les modifications très utiles

L'info de repérage n'est pas nécessaire et il est vrai que la mise en forme hauteur 50 lors de la validation de 'USF serait génial, d'ailleurs il faudrait aussi que la dernière ligne ajoutée s'intègre au tableau pour bénéficier de la mise en forme conditionnelle

Selon vos indication j'ai paramétré les Max lenght de champs

Je vais tenter de travailler sur les points ci-dessous :

- La macro de copie fonctionne bien, cependant, il n'est pas nécessaire de copier les colonnes O à S, serait-il possible que lorsque la ligne se copie vers l'autre feuille "liste adopté", la ligne se supprime dans la feuille de diffusion ?

- Savez-vous si pour l'import photo, on peut créé un lien hypertexte automatique vers le dossier du loulou ?

Merci beaucoup

Cdlt

Fabien

Bonjour toutes et tous

@Fabien62

Pour la colonne A de la feuille 'Liste de diffusion' pour la hauteur des lignes à 50

tu peux mettre dans le Thisworkbook à l'ouverture du classeur et à la fermeture du classeur* (facultatif*)

(voir image)

avant fermeture du classeur

Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Sheets("Liste diffusion")
.Columns("A:A").RowHeight = 50 ' merci à Dan
End With
End Sub

lors de l'ouverture du classeur

Private Sub Workbook_Open()
With Sheets("Liste diffusion")
.Columns("A:A").RowHeight = 50  ' merci à Dan
End With
End Sub

(voir image z75)

Note:

j'ai voulu ci-dessous le code l'implanté dans l'userform saisie

Selection.RowHeight = 50                 ' hauteur de la ligne

cela a fonctionné 1 seule fois (j'ai sans doute oublié de lui dire la colonne, j'ai laissé tombé)

Pour ta feuille 'Liste de diffusion pour la mise en forme conditionnelle, tu peux sélectionner la colonne

(voir image z51)

(voir image z60)

ok puis, appliquer

idem pour Mâle en modifiant le remplissage (bleu)..

reste:

pour supprimer le contenu des colonnes O jusqu'à S

pour supprimer la ligne dans liste diffusion une fois transfert effectué vers liste adoptés

crdlt,

André

z75 z51 z60

Re

@André: Dans les codes ajoute les points devant Columns pour dire que c'est sur la feuille "Liste diffusion"

With Sheets("Liste diffusion")
      .Columns("A:A").RowHeight = 50
End With

Cordialement

Bonjour toutes et tous,

merci Dan pour cette uinformation pour la colonne

crdlt,

André

Bonsoir à vous,

Merci pour vos données, je vais tout compiler dans le fichier car j'ai aussi avancé de mon côté, je vous fait un retour dès que possible

Merci pour tout

Cdlt

Bonjour à tous,

Ci-joint le fichier final

Il manque juste une bricole, j'aimerais que lorsque j'insère une ligne via le USF, le tableau contenant la mise en forme se dimensionne à la dernière ligne entrée de la colonne A, actuellement dans le vba je l'ai mis en défaut pour 1000 lignes, ce n'est pas obligatoire, c'est juste de la curiosité pour apprendre.

' DimTableau Macro
Range("Diffusion").Select
Application.CutCopyMode = False
ActiveSheet.ListObjects("Diffusion").Resize Range("$A$1:$U$1000")

Cordialement

Re

le tableau contenant la mise en forme se dimensionne à la dernière ligne entrée de la colonne A,

Vous pouvez expliquer car j'ai pas trop compris ce que vous voulez faire, de même avec le code

Rechercher des sujets similaires à "configurer userform"