Etiquette vba

coolreds · 19 Février 2009

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 · 19 Février 2009

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

Code:

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

Etiquette vba

coolreds

XLDnaute Occasionnel

Pièces jointes

PMO2

XLDnaute Accro

Discussions similaires