XL 2021 création d'étiquettes

[Alain30]

Bonjour,
En pièce jointe, une demande de création d'étiquettes.

Merci pour votre aide

Alain

 

[Alain30]

Bonjour AIGOIN, le forum,

Le code fait pourtant la même chose qu'au post #38 mais en effet j'ai ajouté dans la Worksheet_Change :

F.Columns.ColumnWidth = 0.1

Essayez en ôtant cette instruction.

A+

C'était bien ça merci beaucoup pour le travail accompli
Bonne journée

 

[Alain30]

C'était bien ça merci beaucoup pour le travail accompli
Bonne journée

Une dernière demande si cela est possible, copier avec une macro toutes les feuilles_expo numériques (1110, 1127, etc.) avec souche éleveur dans fichier étiquettes_expo, j'ai essayé mais en vain (bouton sur la feuille étiquette)
Merci
Alain

 

[job75]

La macro affectée au bouton :

Sub RapatrierFeuilles()
Dim fichier As Variant, w As Worksheet
Do
    fichier = Application.GetOpenFilename("Fichiers Excel (*.xls*),*.xls*")
Loop While Mid(fichier, InStrRev(fichier, "\") + 1) = ThisWorkbook.Name
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---suppression des feuilles existantes---
For Each w In Worksheets
    If IsNumeric(w.Name) Then w.Delete
Next w
'---copie les feuilles du fichier choisi---
With Workbooks.Open(fichier) 'ouverture du fichier
    For Each w In .Worksheets
        If IsNumeric(w.Name) Then w.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    Next w
    .Close False 'fermeture
End With
Sheets("Créations").Activate
End Sub

 

[Alain30]

La macro affectée au bouton :

Sub RapatrierFeuilles()
Dim fichier As Variant, w As Worksheet
Do
    fichier = Application.GetOpenFilename("Fichiers Excel (*.xls*),*.xls*")
Loop While Mid(fichier, InStrRev(fichier, "\") + 1) = ThisWorkbook.Name
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---suppression des feuilles existantes---
For Each w In Worksheets
    If IsNumeric(w.Name) Then w.Delete
Next w
'---copie les feuilles du fichier choisi---
With Workbooks.Open(fichier) 'ouverture du fichier
    For Each w In .Worksheets
        If IsNumeric(w.Name) Then w.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    Next w
    .Close False 'fermeture
End With
Sheets("Créations").Activate
End Sub

Merci beaucoup, c'est super
Bonne soirée

 

[job75]

Bonjour le forum,

J'ai remplacé les 2 OptionButtons par une CheckBox.

A+

 

[Alain30]

Bonjour le forum,

J'ai remplacé les 2 OptionButtons par une CheckBox.

A+

je ne vois rien

 

[Alain30]

je ne vois rien

Votre contribution fonctionne très bien donc mon projet avec userform combobox n'est pas réalisable
Merci

 

[job75]

Votre contribution fonctionne très bien donc mon projet avec userform combobox n'est pas réalisable
Merci

Ce n'est pas ce que j'ai dit :

https://excel-downloads.com/threads/etiquettes.20088470/#post-20703071

 

[Alain30]

Votre contribution fonctionne très bien donc mon projet avec userform combobox n'est pas réalisable
Merci

Je pensais naïvement que votre super travail était adaptable à mon projet global ci-joint quant à moi j'en suis bien sur incapable merci quand même

 

[job75]

Ce que je peux faire de plus c'est ajouter une 2ème CheckBox et créer un fichier PDF après les impressions :

Sub Imprimer()
If CheckBox1 Then F.PrintPreview Else F.PrintOut 'pour voir l'aperçu
If CheckBox2 Then
    npage = npage + 1
    F.Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Page" & npage
End If
F.DrawingObjects.Delete 'RAZ
n = 0: X = 0: Y = 0
End Sub

Dans la Worksheet_Change :

If CheckBox2 Then
    Sheets("Page1").Select
    For i = 2 To npage
        Sheets("Page" & i).Select False
    Next i
    ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & [J3] & ".pdf"
    For i = 1 To npage
        Sheets("Page" & i).Delete
    Next i
    npage = 0
    Me.Select
End If