Multiplie x fois la copie d'un texte au départ d'une cellule
re,
Je cherche pour ajouter image avec liste dans l'userform et je re post.
Merci beaucoup
Frederique
re
En cherchant sur les différents forum et autres, voir en bas dans le code UserForm1 de la pièce jointe mais une erreur se produit
nf = Dir("*.*")Dans le fichier original il n'y a pas "Dim nf as ..."
Pouvez-vous me dire ce qui se passe ?
Par la suite, je voudrais que l'image selectionnée dans la liste "LstBoxImages" soit afficher dans Etiquettes conserves donc "OptButtonCons" coché
Merci
Frederique
Bonjour
Rajoutes les lignes surlignées en début de macro
Private Sub UserForm_Initialize()
Dim Nf As String
Dim N As IntegerEnsuite si CurDir() te donne le bon chemin pas de soucis, sinon à toi d'adapter le chemin
exemple
ChDir "le chemin des images"A toi de remplacer "le chemin des images" par ton vrai chemin
bonsoir,
Je ne comprends pas trop
ChDir CurDir()ChDir : recherche répertoire
CurDir : ???? et comment lui indiqué le chemin ?
Dans le fichier original,
Dim Nf As String
Dim N As Integern'existe pas et pourtant tout fonctionne sans erreur, alors que dans le mien, ça bug
Pourquoi ?
Merci
Bonjour
ChDir ne cherche pas un répertoire, il change de répertoire
CurDir() te donne le répertoire courant
si dans ce répertoire tu as les images que tu veux, ne change rien dans la macro
S'il ne donne pas le bon répertoire il faut que tu notes en dur (dans la macro) le chemin du répertoire de tes images
fredoud a écrit :CurDir : ???? et comment lui indiqué le chemin ?
Moi je ne connais pas le tien donc je ne sais pas quoi marquer
Au sujet de la déclaration des variables
Dim Nf As String
Dim N As IntegerDans ce fichier j'emploie
Option Explicitqui oblige à déclarer toutes les variables
re,
J'ai trouvé le problème comme vous me l'avez indiqué en relisant ligne par ligne.
Est-il possible d'ajouter le nom de l'image sélectionner dans ListBox et l'ajouter pour étiquettes conserves ?
Partie du code que vous avez écrit et qui fonctionne parfaitement
Dim PDepart As String, Validite As String
Dim TextEtiquette As String, PremLig As String, SecLig As String, TrLig As String
Dim Indice As Integer, I As Integer
Dim Ctl As Control
'Colonne = Me.CBoxColonne
'Ligne = Me.CBoxLigne
If Me.CBoxNombre.ListIndex = -1 Then
MsgBox "Veuillez indiquez une quantité"
With CBoxNombre
.BorderStyle = 1: .BorderColor = RGB(255, 0, 0)
.SetFocus
End With
With LblNombre
.Font.Bold = True: .ForeColor = RGB(255, 0, 0)
End With
Exit Sub
End If
If Me.CBoxColonne.ListIndex = -1 Then
MsgBox "Veuillez indiquez une colonne de départ"
With CBoxColonne
.BorderStyle = 1: .BorderColor = RGB(255, 0, 0)
.SetFocus
End With
With LblColonne
.Font.Bold = True: .ForeColor = RGB(255, 0, 0)
End With
Exit Sub
End If
If Me.CBoxLigne.ListIndex = -1 Then
MsgBox "Veuillez indiquez une ligne de départ"
With CBoxLigne
.BorderStyle = 1: .BorderColor = RGB(255, 0, 0)
.SetFocus
End With
With LblLigne
.Font.Bold = True: .ForeColor = RGB(255, 0, 0)
End With
Exit Sub
End If
PDepart = Me.CBoxColonne & Me.CBoxLigne
'Première ligne qui sera mise au format gras (voir plus bas)
PremLig = CBoxProduit & " - " & CBoxMarque & Chr(10)
'Deuxième ligne sans modification du format
SecLig = "Mise en conditionnement le : " & TxtBoxDate & Chr(10)
'Troisième ligne qui sera mise au format italique (voir plus bas)
TrLig = "A consommer avant le " & TxtBoxDLC
TextEtiquette = PremLig & SecLig & TrLig
With Sheets(NomFeuille)
If Me.OptButtonH = True Then ' Mode horizontal
Indice = ((.Range(PDepart).Row - 1) * NombreColonne) + .Range(PDepart).Column - 1
Else ' Mode vertical
Indice = (.Range(PDepart).Row - 1) + (.Range(PDepart).Column - 1) * NombreLigne
End If
If Indice + Val(Me.CBoxNombre) > NombreMaxiEtiquettes Then
MsgBox "Impossible de copier " & Me.CBoxNombre & " étiquettes" & vbCr & vbCr & vbCr & _
" Au maximum possibilité de créer " & 1 + NombreMaxiEtiquettes - Indice & " étiquettes" & vbCr & vbCr, vbInformation
Exit Sub
End If
With .Range(PDepart)
.Value = TextEtiquette
'Application de format pour les lignes ci dessus
.Characters(Start:=1, Length:=Len(PremLig)).Font.Bold = True
.Characters(Start:=Len(PremLig) + Len(SecLig), Length:=Len(TrLig)).Font.Italic = True
End With
For I = 1 To Val(Me.CBoxNombre) - 1
Indice = Indice + 1
If Me.OptButtonH = True Then ' Mode horizontal
.Range(PDepart).Copy Destination:=.Cells(1 + (Indice \ NombreColonne), 1 + (Indice Mod NombreColonne))
Else ' Mode vertical
.Range(PDepart).Copy Destination:=.Cells(1 + (Indice Mod NombreLigne), 1 + (Indice \ NombreLigne))
End If
Next IMerci
Frederique
Bonsoir
Tu prépares un fichier avec le résultat que tu veux cela sera le mieux
re,
Je renvoie ci-joint le fichier précédemment uploader et positionner sur la feuille "Etiquettes 2" afin d'avoir aperçu de ce que je souhaite obtenir au final.
Merci
Frederique
bonjour Banzai64,
Merci ça fonctionne.
Dans la poursuite de creation de fichier, j'ai ajouter ceci
Private Sub CBoxProduit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Plage As Range, Cel As Range
If CBoxProduit <> "" Then
With Sheets(3)
Set Plage = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
End With
Set Cel = Plage.Find(CBoxProduit.Text, , xlValues, xlWhole)
If Cel Is Nothing Then
UserForm2.Nom_Produit
UserForm2.Show
End If
Else
Exit Sub
End If
End Sub
Public Sub Nom_Produit()
UserForm2.TxtBoxProduit.Value = UserForm1.CBoxProduit
End Subje me retrouve avec une erreur d'execution '481': image incorrecte.
Avec le code que j'ai ajouté, il vérifie que CBoxProduit est existant dans liste en feuille3,
si non, UserForm2 s'affiche en copiant le contenu de CBoxProduit vers TxtBoxProduit de l'UserForm2
si oui, alors rien ne se passe et poursuite de la saisie UserForm1 mais là j'ai un problème il affiche quand même l'UserFom2 alors que le produit est déjà dans la liste
si CBoxProduit est vide, là aussi aucune fenêtre s'affiche et je poursuit la saisie dans UserForm1 (ça marche)
Merci
Frederique
Bonjour
Il faut (si des changements existent) que tu joignes le fichier modifié
Tu expliques comment tu fais pour avoir l'erreur
re,
Désolé, je suis vraiment tête en l'air. L'erreur apparait lorsque je clique sur bouton "Etiquettes" de la feuille "---Dashboard---".
Merci
Frederique
Bonjour
je viens d'essayer et je n'ai pas d'erreur quand je clique sur le bouton "Etiquettes" de la feuille "---Dashboard---"
Donc je ne peux pas te répondre
Surtout ce message d'erreur ne me dit pas grand chose
Quand tu as ce message d'erreur cliques sur "Aide" tu auras peut-être la raison de cette erreur
bonjour Banzai64,
Merci du conseil.
Au sujet du code ajouté
Tout sélectionnerPrivate Sub CBoxProduit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Plage As Range, Cel As Range
If CBoxProduit <> "" Then
With Sheets(3)
Set Plage = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
End With
Set Cel = Plage.Find(CBoxProduit.Text, , xlValues, xlWhole)
If Cel Is Nothing Then
UserForm2.Nom_Produit
UserForm2.Show
End If
Else
Exit Sub
End If
End Sub
Public Sub Nom_Produit()
UserForm2.TxtBoxProduit.Value = UserForm1.CBoxProduit
End Subil vérifie si CBoxProduit est existant dans liste en feuille3,
- si non, UserForm2 s'affiche en copiant le contenu de CBoxProduit vers TxtBoxProduit de l'UserForm2
- si oui, alors rien ne se passe et poursuite de la saisie UserForm1 mais là j'ai un problème il affiche quand même l'UserFom2 alors que le produit est déjà dans la liste
Pourquoi ?
- et si CBoxProduit est vide, là aussi aucune fenêtre s'affiche et je poursuit la saisie dans UserForm1 (ça marche)
Merci
Frederique
Bonjour
Remplaces ta macro
Private Sub CBoxProduit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Plage As Range, Cel As Range
If CBoxProduit <> "" Then
With Sheets(4) ' Car la page est à la 4ème position
' Ou With Feuil3 ' Avec le CodeName (change très rarement)
' Ou With Sheets("Listes") ' Avec le nom de la page (plus simple mais à modifier si changement du nom)
Set Plage = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
End With
Set Cel = Plage.Find(CBoxProduit.Text, , xlValues, xlWhole)
If Cel Is Nothing Then
'UserForm2.Nom_Produit ' Contrôle inexistant et mauvaise syntaxe
' UserForm2.Nom_Produit = Me.CBoxProduit
UserForm2.Show
End If
End If
End Subre Banzai64,
le problème persiste. Je m'explique plus correctement
Exemple avec courgette:
Quand je commence à taper courgette et que celle-ci se trouve dans la liste alors les mots apparaissent
au fur et à mesure de la saisie
courge
courgette
je selectionne courgette ensuite je clique sur TextBox suivant pour remplir le reste du formulaire !
mais ce qui se passe actuellement, c'est que la fenêtre Userform2 s'affiche quand même
Pourquoi ?
Si courgette n'existe pas alors UserForm2 s'affiche et courgette doit s'inscrire dans "TxtBoxProduit" afin d'éviter la re-saisie d'où le code
UserForm2.Nom_ProduitComment faire ?
Merci
Frederique
Bonjour
Moi je vais arrêter car ma tension augmente chaque fois que je lis un de tes messages
As tu essayé de remplacer la macro existante par celle que je t'ai proposé
Je viens de
Charger ton fichier
Remplacer la macro existante par celle que je t'ai proposée
D'appuyer sur le bouton Etiquettes dans la page "---Dashboard---"
De choisir "Courgette" (au fait "Courge n'est pas dans la liste - mais passons)
De sélectionner un autre contrôle
Et miracle l'userform2 ne s'affiche pas
J'ai refais en tapant dans "Courge" dans CBoxProduit ensuite changement de contrôle et la par une chance inouïe (non je plaisante) l'userform2 s'affiche
Alors si les réponses tu ne les lis pas ou tu n'en tient pas compte (c'est la même chose) je ne vais plus essayer de te trouver des solutions
Et ce n'est pas la 1ère fois que je te dis ça
re,
je suis vraiement désolé de vous avoir offensé, de mal m'exprimer et que l'on se comprenne pas.
Oui, je fais bien les tests avec le fichier mais c'est avec l'autre fichier que cela bug. Celui sur laquelle, je fais les demande par Internet me sert de supportAs tu essayé de remplacer la macro existante par celle que je t'ai proposé
Effectivement courge n'est pas dans la liste, c'était un exemple
En faisant ce qui suit dans UserForm1 on place ce code à la fin
UserForm2.Nom_Produit
UserForm2.Show
End If
End If
End Subet celui-ci dans UserForm2
Public Sub Nom_Produit()
UserForm2.TxtBoxProduit.Value = UserForm1.CBoxProduit
End Subça fonctionne mais pose le problème cité précédemment. Donc ...
Du coup, je laisse le code que vous cité et qui fonctionne parfaitement
Private Sub CBoxProduit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Plage As Range, Cel As Range
If CBoxProduit <> "" Then
With Sheets(4) ' Car la page est à la 4ème position
' Ou With Feuil3 ' Avec le CodeName (change très rarement)
' Ou With Sheets("Listes") ' Avec le nom de la page (plus simple mais à modifier si changement du nom)
Set Plage = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
End With
Set Cel = Plage.Find(CBoxProduit.Text, , xlValues, xlWhole)
If Cel Is Nothing Then
'UserForm2.Nom_Produit ' Contrôle inexistant et mauvaise syntaxe
' UserForm2.Nom_Produit = Me.CBoxProduit
UserForm2.Show
End If
End If
End Submais après je bloque
Exemple
Si courgette n'existe pas alors UserForm2 s'affiche et courgette doit s'inscrire dans "TxtBoxProduit" afin d'éviter la re-saisie d'où le code
Encore une fois, désolé et merci
Frederique
Bonsoir
Bon je vais essayer de reprendre
Tu modifies ton fichier mais moi je ne vois pas les modifications que tu fais
Il est impératif que tu joignes le fichier que tu modifies en indiquant l'endroit où il bloque et les actions que tu as faite pour y arriver
Lis bien les réponses que l'on te donne
Si tu testes la réponse et qu'elle te convient inclue la dans ton fichier
On ne va pas répéter tout sans arrêt
J'essaie de mettre des commentaires dans le code (ce n'est pas pour mon côté écolo) mais parce que cela donne des indications
Lis les (si tu les aurais lus tu ne poserait pas ta question)
'UserForm2.Nom_Produit ' Contrôle inexistant et mauvaise syntaxe
' UserForm2.Nom_Produit = Me.CBoxProduitSi tu places ce contrôle (Nom_Produit) dans l'Userform2 et que tu enlèves le commentaire de la 2ème ligne --> problème résolu
bonjour Banzai64,
J'ai pris mon temps pour bien lire et comprendre ce que vous me conseillez et m'apprendre.
J'arrive à mes fins mais de temps en temps j'ai la fenêtre "erreur d'exécution '481': Image incorrecte" qui apparait. Ce que je ne comprends pas c'est que vous n'avez cette erreur alors que c'est le même fichier.
Une idée ?
Merci pour tout et de votre patience.
Frédérique