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

dubarre

XLDnaute Occasionnel
Supporter XLD
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.
 
Ce fil a été résolu! Aller à la solution…

Fichiers joints

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:

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!!"" ( :p )
 

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
 
Ce message a été identifié comme étant une solution!

dubarre

XLDnaute Occasionnel
Supporter XLD
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
 

dubarre

XLDnaute Occasionnel
Supporter XLD
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
 

dubarre

XLDnaute Occasionnel
Supporter XLD
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:

dubarre

XLDnaute Occasionnel
Supporter XLD
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.
 

Fichiers joints

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
1604126787250.png
 

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
 

patricktoulon

XLDnaute Barbatruc
re
oui ton inputboxdk c'est seulement pour masquer ce que tu tape dans l'inputbox avec des "*"
c'est quoi l'utilité en fait ???
 

patricktoulon

XLDnaute Barbatruc
re
et tout a fait entre nous je n'en vois pas l'utilité si le mot de passe doit être visible dans VBA pour être comparer à ce qui a été tapé

sinon c'est simple on peut faire exactement la même chose que ton inputbox intercepté par du hooking avec un simple userform avec le textbox en password
sans api sans galère dans le teston

démonstration d'un vrai faux inputbox
demo6.gif
 

Fichiers joints

dubarre

XLDnaute Occasionnel
Supporter XLD
Bonjour

@patricktoulon tout d'abord merci de m'aider à améliorer ce classeur je t'explique ce classeur va être utilisé par l'association dont je fais parti je suis en train de le créer pour eux et il n'y a que certaines personnes qui vont avoir accès je n'ai trouvé que cette façon pour pouvoir taper le mot de passe et que ce soit des étoiles à la place ce que m'a demandé mon responsable je vais regarder ce que tu proposes au-dessus.

J'aurais une petite question dans la déclaration suivante pour les formulaires
VB:
 Dim oldW#, oldH#, ctrl, CfnewW#, CFnewH#, D
pourquoi certaines personnes mettent exemple :as integer ou autre et que certaines personnes comme vous ne mettes rien c'est quoi l'utilité de le mettre ou de ne pas la mettre s'il vous plaît.
 

patricktoulon

XLDnaute Barbatruc
re
je ne met pas tout le temps rien , je met # ou & ou $ ou % ou rien
# = as double
&= as long
$= as string
%= as integer
quand je met rien par exemple ctrl c'est que c'est un object ou une variable tableau
 

dubarre

XLDnaute Occasionnel
Supporter XLD
re @patricktoulon

d'accord je ne savais pas que ça voulait définir sa est-ce que c'est universel ou c'est toi qui le déclares au départ du classeur je sais ma question peux paraître bête mais pour moi c'est universel en tout cas ça me semble.

D'autre part je voulais te poser la question par rapport à ce que tu me proposes dans le classeur vrai-faux j'ai à-peu-près compris comment fonctionne le formulaire mode passe mais comment lui attitré un mot de passe et qu'il soit sécurisé je sais que je peux mettre un mot de passe sur le code VBA mais qui est facilement craquable pour en avoir fait le test il y a-t-il une autre façon de sécuriser le classeur hormis le mot de passe au tout début de l'ouverture du classeur.
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas