Etiquette vba

[coolreds]

Bonjour,

j'utilise un code vba pour le remplacement de mes codes par des prix

le remplacement se fait bien mais je voudrai juste que au lieu
que l'article remplacé se place a droite et non a gauche

ex : SA000010 se remplace par 31,90 sur la planche d'etiquette
il se serre a gauche et je voudrai qu'il se serre a droite mais sans déplacer
la mise en forme de l'etiquette

merci de votre aide


Private Sub CommandButton1_Click()
Test
End Sub
Sub Test()
Dim xlApp As Object
Chemin = Me.Path
Fichier = "TARIF CODE.xls"
Set xlApp = CreateObject("excel.application")
xlApp.Visible = False
Set MonFichier = xlApp.Workbooks.Open(FileName:=Chemin & "\" & Fichier)
Set MaZone = MonFichier.sheets("Feuil1").Range("A2", MonFichier.sheets("Feuil1").Range("A65536").End(-4162))
For Each X In MaZone
Selection.HomeKey Unit:=wdStory
With Selection.Find
.Text = X
.MatchWholeWord = True
.Replacement.Text = X.Offset(0, 1)
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
xlApp.Quit
Set xlApp = Nothing
End Sub


cordialement

 

[PMO2]

Re : Etiquette vba

Bonjour,

Une piste avec votre code modifié ci-dessous.
L'idée est de remplacer les caractères qui manquent par des espaces.
Je n'ai pas pu tester concrètement, ne disposant pas du fichier TARIF CODE.xls

Sub Test_pmo()
Dim xlApp As Object
Chemin = Me.Path
Fichier = "TARIF CODE.xls"
Dim nbChar1& 'ajout pmo
Dim nbChar2& 'ajout pmo
Set xlApp = CreateObject("excel.application")
xlApp.Visible = False
Set MonFichier = xlApp.Workbooks.Open(FileName:=Chemin & "\" & Fichier)
Set MaZone = MonFichier.sheets("Feuil1").Range("A2", _
    MonFichier.sheets("Feuil1").Range("A65536").End(-4162))
For Each x In MaZone
  Selection.HomeKey Unit:=wdStory
  With Selection.Find
    nbChar1& = Len(Trim(x)) 'ajout pmo
    .Text = x
    .MatchWholeWord = True
    nbChar2& = Len(Trim(CStr(x.Offset(0, 1))))  'ajout pmo
    .Replacement.Text = Space(nbChar1& - nbChar2&) & x.Offset(0, 1) 'modif pmo
  End With
  Selection.Find.Execute Replace:=wdReplaceAll
Next
xlApp.Quit
Set xlApp = Nothing
End Sub

Cordialement.

PMO
Patrick Morange