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 Integer

Ensuite 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 Integer

n'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 Integer

Dans ce fichier j'emploie

Option Explicit

qui 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 I

Merci

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

Bonsoir

A voir

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 Sub

je 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 Sub

il 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 Sub

re 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_Produit

Comment 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.

As tu essayé de remplacer la macro existante par celle que je t'ai proposé

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 support

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 Sub

et 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 Sub

mais 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.CBoxProduit

Si 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

Rechercher des sujets similaires à "multiplie fois copie texte depart"