Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Enlever les espaces dans une colonne pour impression code VBA

D

dubarre

XLDnaute Occasionnel
Bonjour à tous

Je viens vers vous car j’ai une petite question à vous poser quand vous ouvrez le classeur vous

cliquez sur « consulter » > édition > « édition courante » > « planche d’étiquette » > « individuelle » et vous mettez au hasard un nom cliquez sur « valider » ensuite cliquez « planche d’étiquettes » ça vous emmène sur l’onglet "Planche_Imp_Indiv"

vous pouvez voir l’adresse en plusieurs fois au format pour les planche d'éttiquette autocollants que je souhaite par contre je voudrais que dans chaque partie d’adresse si il y a des espaces entre les lignes qu’elle se comble automatiquement

car plusieurs adresses n’ont pas le même nombre de lignes il y a des compléments d’adresse qu’il y a pas dans d’autres et ainsi de suite donc je voulais savoir comment j’aurais pu organiser ça s’il vous plaît en code VBA

j’ai voulu tester dans Word mais je n’arrive pas à comprendre comment cela fonctionne et en plus je voudrais importer l’adresse directement mais ça devient compliqué donc je pense que le plus simple c’est de le faire sur une page Excel que j’ai réussi à mettre en forme selon ma planche d’étiquettes personnalisée.

Toutes les idées son les bien venue s'il vous plaît.
 

Pièces jointes

  • Gestion_des_Artistes_vedparticul.xlsm
    781.9 KB · Affichages: 39
Solution
re:
tiens vire TOUT!!!!!!!(interminable) ton evenement "CommandButton14_clicl()"
et met celui ci
VB: 
Private Sub CommandButton14_Click()
    Dim baseDD As Worksheet, a&, TbL
    Unload Me
    Unload UserForm6
    Sheets("Planche_Imp_Indiv").Visible = True
    Set baseDD = Sheets("Planche_Imp_Indiv")
    '--------------------------------------------------------------
    'Impression étiquette colonnes 1 et 2
    '--------------------------------------------------------------
    texte = Me.CbxCivilite.Value & " " & Me.TextBox2.Value & " " & Me.TextBox24.Value & "," & Me.TextBox3.Value & "," & Me.TextBox4.Value & "," & Me.TextBox5.Value & "," & Me.TextBox6.Value & "," & Me.TextBox7.Value & "," & Me.TextBox9.Value & ","
    TbL =...
Trier par date Trier par votes

patricktoulon

XLDnaute Barbatruc
re
ton module 5
ceci fonctionnera sur les deux
VB: 
Option Explicit
'Code geschrieben von Daniel Klann
#If vb7 Then
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongLong, ByVal ncode As LongLong, ByVal wParam As LongLong, lParam As Any) As LongLong
Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongLong
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongLong, ByVal lpfn As LongLong, ByVal hmod As LongLong, ByVal dwThreadId As LongLong) As LongLong
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongLong) As LongLong
Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongLong, ByVal nIDDlgItem As LongLong, ByVal wMsg As LongLong, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongLong, ByVal lpClassName As String, ByVal nMaxCount As LongLong) As LongLong
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongLong
Public Function NewProc(ByVal lngCode As LongLong, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
Private hHook As LongLong
#Else
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private hHook As Long
#End If
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0
Dim RetVal
Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim strClassName As String, lngBuffer As LongLong
If lngCode < HC_ACTION Then
    NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
    Exit Function
End If
strClassName = String$(256, " ")
lngBuffer = 255
If lngCode = HCBT_ACTIVATE Then
    RetVal = GetClassName(wParam, strClassName, lngBuffer)
        If Left$(strClassName, RetVal) = "#32770" Then
        SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If
End If
CallNextHookEx hHook, lngCode, wParam, lParam
End Function

Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
Optional YPos, Optional HelpFile, Optional Context) As String
Dim lngModHwnd As LongLong, lngThreadID As LongLong
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
UnhookWindowsHookEx hHook
End Function

Sub MdpEntrer()

Dim Mdp As String

'Mdp = InputBoxDK("Entrer le mot de passe", "Demande")
'
'If Mdp <> "Apbp67120" Then
'MsgBox "Le mot de passe est incorrect", vbCritical
'Exit Sub
'ElseIf Mdp = "Apbp67120" Then

            Feuil1.Visible = True
            Feuil1.Activate
            Feuil2.Visible = xlSheetHidden
            Feuil3.Visible = xlSheetHidden
            Feuil5.Visible = xlSheetHidden
            Feuil6.Visible = xlSheetHidden
            Feuil8.Visible = xlSheetVeryHidden

        Feuil1.Range("A1:X52").Select
        ActiveWindow.Zoom = True
       Cells(1, 1).Select

'End If




End Sub

Sub MdpConsulter()

        Feuil5.Visible = True
        Feuil3.Visible = True
        Feuil5.Activate
        Feuil1.Visible = xlVeryHidden
        Feuil2.Visible = xlVeryHidden
       
With Feuil5.Cells
    .EntireColumn.Hidden = False
    .EntireRow.Hidden = False
    .Clear
    .Interior.ColorIndex = xlNone
    '.HorizontalAlignment = xlCenter
    '.VerticalAlignment = xlCenter
    '.ColumnWidth = 15
    '.RowHeight = 15
End With


       
Feuil5.Cells.Clear
ThisWorkbook.Sheets("BDD").Range("A1").CurrentRegion.Copy Sheets("Vue_listes_artistes").Range("A1")

    'Rows("1:2").Select
    'Range("A2").Activate
    'Selection.EntireRow.Hidden = True
UserForm9.Show

Range("A1").Select
    Selection.AutoFilter

End Sub
 
Dernière édition:
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
re
ok j'ai regardé ton problème est simple tu a codé l'ecriture sur baseBDD(("Planche_Imp_Indiv")
EN DUR!!!
parti de là comme tout les artistes n'ont pas toutes les ligne remplies ben tu te retrouve avec des lignes vides

mon idée
tu crée un array avec les données (celles qui sont pleines)et dans une boucle tu les trafert dans baseBDD et a chaque tour de boucle donc étiquette suivante sur la planche tu saute une seule ligne

c'est simple non ?

à nouveau je le répète car ça devient pénible de vous filer un coup de main
""arrêter de faire des userform 4k!!"" ( )
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
re:
tiens vire TOUT!!!!!!!(interminable) ton evenement "CommandButton14_clicl()"
et met celui ci
VB: 
Private Sub CommandButton14_Click()
    Dim baseDD As Worksheet, a&, TbL
    Unload Me
    Unload UserForm6
    Sheets("Planche_Imp_Indiv").Visible = True
    Set baseDD = Sheets("Planche_Imp_Indiv")
    '--------------------------------------------------------------
    'Impression étiquette colonnes 1 et 2
    '--------------------------------------------------------------
    texte = Me.CbxCivilite.Value & " " & Me.TextBox2.Value & " " & Me.TextBox24.Value & "," & Me.TextBox3.Value & "," & Me.TextBox4.Value & "," & Me.TextBox5.Value & "," & Me.TextBox6.Value & "," & Me.TextBox7.Value & "," & Me.TextBox9.Value & ","
    TbL = Application.Transpose(Split(Replace(Replace(texte, ",,,", ","), ",,", ","), ","))
    With baseDD
        For i = 1 To 7
              a = 8 * (i - 1) + 1    ' si on garde cette mise en page
            .Cells(a, 2).Resize(UBound(TbL)).Value = TbL
            .Cells(a, 1).Resize(UBound(TbL)).Value = TbL
        Next
        .PrintPreview
        .[A:B].ClearContents 'tu avais oublié
        .Visible = False
    End With
End Sub

tu avais oublié le clear
car quand tu imprime des étiquettes qui ont moins de données que les précédentes certaines données restaient bien évidemment (c'est ballo!!!)
met aussi [A:B] alignée a gauche!!!!(et oui le code postal est un numérique donc aligné a droite automatiquement ) c’était pas cohérent visuellement avec le texte qui lui est aligné a gauche
 
Vote positif 0 Vote négatif
Solution
D

dubarre

XLDnaute Occasionnel
Bonjour à tous merci de m'aider pour le problème je décide de prendre note de tout ce que vous m'avez dit je n'ai pas le temps aujourd'hui de faire des essais mais je vais essayer de faire ça ce week-end

J'ai juste eu le temps d'essayer ce que tu m'as proposé dans le poste quatre il me met un message d'erreur sur le #Else j'essaierai de voir ce week-end pourquoi il ne met ce problème encore une fois en vous remerciant de votre aide cordialement.

VB: 
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongLong, ByVal ncode As LongLong, ByVal wParam As LongLong, lParam As Any) As LongLong
Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongLong
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongLong, ByVal lpfn As LongLong, ByVal hmod As LongLong, ByVal dwThreadId As LongLong) As LongLong
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongLong) As LongLong
Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongLong, ByVal nIDDlgItem As LongLong, ByVal wMsg As LongLong, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongLong, ByVal lpClassName As String, ByVal nMaxCount As LongLong) As LongLong
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongLong
Public Function NewProc(ByVal lngCode As LongLong, ByVal wParam As LongLong, ByVal lParam As LongLong) As LongLong
Private hHook As LongLong
#Else
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private hHook As Long
 
Vote positif 0 Vote négatif
D

dubarre

XLDnaute Occasionnel
Rebonjour juste pour répondre aux messages de Chris j'ai essayé de le faire sur Word mais je ne trouve pas de tutoriel qui permette d'expliquer pour un seul individu cela fonctionne pour le publipostage avec plusieurs données dont plusieurs adresses mais pour un seul individu je n'arrive pas à trouver si quelqu'un a un tutoriel à proposer sur le sujet je suis preneur aussi cordialement
 
Vote positif 0 Vote négatif
D

dubarre

XLDnaute Occasionnel
Bonjour à tous c'est vrai que concernant les lignes vide tu ma aider à réglait le problème par contre pour ma connaissance personnelle je voudrais essayer de trouver comment ça fonctionne sur Word s'il vous plaît
 
Dernière édition:
Vote positif 0 Vote négatif
D

dubarre

XLDnaute Occasionnel
Bonjour

Je viens de tester la proposition de @patricktoulon concernant les éditions étiquettes ça fonctionne correctement.

Par contre un peu plus haut vous proposez les rectifications sur le module 5
et comme vous pouvez voir sur la photo que je vous envoie j'ai un message d'erreur concernant "adresseoff" et la ce que vous proposez je n'ai pas encore tout compris je sais que c'est des déclarations mais je n'ai pas encore tout vu sur le fonctionnement

J'ai juste compris que cela à une interférence avec le mot de passe que je demande dans un inputbox sur le bouton "Mise à jour" je vous joins le classeur où j'ai testé le code en vous remerciant.
 

Pièces jointes

  • Capture.JPG
    170.6 KB · Affichages: 14
  • Gestion_des_Artistes_vedparticul.xlsm
    770 KB · Affichages: 6
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
bonjour @dubarre
ça c'est un userform en 4k
ceci est un cliché de mon écran complet (je vois pas le bas et le reste à droite )
j'ai été obligé de fermer excel par ctrl alt supp(gestion de tache) tu vois le topo
je regarde le reste mais bon comment veux tu travailler correctement avec ça
demain tu change d’écran ça ira plus
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
re

déjà pour commencer

dans tes userform1 , userform2 ,userform8

met ceci avant le "end sub" de l'initialise

VB: 
 '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
    'SCALE TO SCREEN                                      $
    '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$


    Dim oldW#, oldH#, ctrl, CfnewW#, CFnewH#, D
    For Each ctrl In Me.Controls
        With ctrl
            .Tag = .Left & ";" & .Top & ";" & .Width & ";" & .Height
            On Error Resume Next
            .Tag = .Tag & ";" & .Font.Size
            Err.clar
        End With
    Next
    oldW = Me.Width: oldH = Me.Height
    Application.WindowState = xlMaximized

    With Me
        .Top = 0: .Left = 0
        .Width = Application.Width
        .Height = Application.Height
        CFnewH = Me.Height / oldH: CfnewW = Me.Width / oldW
        For Each ctrl In .Controls
            D = Split(ctrl.Tag, ";")
            With ctrl
                .Move D(0) * CfnewW, D(1) * CFnewH, D(2) * CfnewW, D(3) * CFnewH
                On Error Resume Next
                .Font.Size = D(4) * Application.Min(CfnewW, CFnewH)
                Err.Clear
            End With

        Next
    End With
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

H
  • Résolu(e)
XL 2019 récupérer une donnée d'un fichier csv pour le copier vers un autre
2
Réponses
27
Affichages
2 K
Hutchy33
H
K
  • Résolu(e)
Microsoft 365 Ouvrir un autre classeur excel (VBA) pour utiliser les données de celui dans le classeur actif
Réponses
5
Affichages
1 K
Dranreb
L
  • Question
Microsoft 365 Extraire les filtres d'une colonne ou d'un segment en VBA et les écrire dans une autre colonne.
2
Réponses
20
Affichages
2 K
LORIS-B
L
D
  • Résolu(e)
Microsoft 365 Problème impression dans l’onglet Membres
Réponses
2
Affichages
810
dubarre
D
A
  • Question
XL 2019 Besoin d'aide pour copier les lignes d'un classeur et les coller dans un autre classeur par le bié d'un bouton (VBA)
Réponses
7
Affichages
986
aka100k
A
  • Question
Microsoft 365 VBA : couper ligne d'un tableau pour coller les valeurs dans une autre feuille.
Réponses
6
Affichages
1 K
Lisette
V
  • Résolu(e)
Microsoft 365 [VBA Excel] Problème pour Réinitialiser les filtres : fonctionne une ou deux fois...
2
Réponses
15
Affichages
2 K
VirginieG
V
T
  • Question
XL 2016 Saisir le n-ième nom d'un onglet dans lequel la valeur recherchée apparait (recherche avec ++ critères)
Réponses
0
Affichages
712
TBENZ
T
N
  • Résolu(e)
XL 2016 Comment filtrer une listbox a mesure qu'on saisie dans textbox (2 colonnes)
2
Réponses
21
Affichages
5 K
ChTi160
A
  • Résolu(e)
XL 2019 VBA - Copie presse papier pour export seulement si une valeur dans les cellules sélectionné
Réponses
6
Affichages
1 K
Akif5723
A
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…