probleme macro copie cellule

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous

je suis débutant en macro et le langage vba oulala :calim2:je rame
Je me trouve dans une impasse, j'aimerai copie une cellule et la coller dans une zone de texte jusqu'a la tout va bien.

Mes cette cellule est modifiable, j'aimerai que la modification soit aussi pris en compte et coller dans la zone de texte.

ci-joint le dossier
cellule modif est le n°ake et le poids
Merci de votre aide :roll:Pièce jointe 183375

Voila le code VBA:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Sub n°ake()
'
' n°ake Macro
'

'
    Range("E3:G5").Select
    Selection.Copy
    ActiveSheet.Shapes.Range(Array("TextBox 9")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "10146 " celui la que j'aimerai modifier 
   Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 6).ParagraphFormat. _
        FirstLineIndent = 0
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 5).Font
        .Bold = msoFalse
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .Italic = msoFalse
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(6, 1).Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .Name = "+mn-lt"
    End With
End Sub
Sub poids()
'
' poids Macro
'

'
    Range("E27:G29").Select
    Selection.Copy
    ActiveSheet.Shapes.Range(Array("TextBox 8")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "1000 "
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 5).ParagraphFormat. _
        FirstLineIndent = 0
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 4).Font
        .Bold = msoFalse
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .Italic = msoFalse
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(5, 1).Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 11
        .Name = "+mn-lt"
    End With
End Sub

Bonjour,

Une piste.

Dans le code de la Feuil1 copier le code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim lePoids As String
 
 
lePoids = Range("E27")
 
ActiveSheet.Shapes.Range(Array("TextBox 8")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = lePoids
 
 
End Sub

20/07/2015, 13h54
adrien1987

mille merci goldstar depuis le temps que je recherche ce code 8-)
sa MArche

J'aimerai comprendre le code pour pouvoir l'appliquer autres date,n°vol etc...

Dans le code de la Feuil1 copier le code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14

Private Sub Worksheet_Change(ByVal Target As Range)

Dim lePoids As String   est ce que il faut changer ?? "lepoids" 


lePoids = Range("E27")   cela est ok, il faut juste mettre la cellule concerner

ActiveSheet.Shapes.Range(Array("TextBox 8")).Select   textbox8 et le nom de la zone de texte? comment trouver leur nom
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = lePoidsest ce que il faut changer ?? "lepoids" 


End Sub

[/QUOTE]

merci de votre aide

1 pièce(s) jointe(s)

bonjour,

je vient de trouver comment faire pour les autres, le seul probleme dans la cellule numéro ake on écrit 888 mes dans la ZoneTexte 9 cela sélectionne la zone mes rien ne s'écrit !

Avez vous une idée?

voila le code vba
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Private Sub Worksheet_Change(ByVal Target As Range) Dim lePoids As String lePoids = Range("G27") ActiveSheet.Shapes.Range(Array("TextBox 8")).Select Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = lePoids Dim numéro_ake As String numéro_ake = Range("G3") ActiveSheet.Shapes.Range(Array("TextBox 9")).Select Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = numero_ake End Sub
Pièce jointe 183468

Bonjour Adrien,

Le probléme vient de la variable numéro_ake pour laquelle vous avez mis un accent.
Code:

1 2 numéro_ake = Range("G3")
alors que à la suite du code l'acent à disparu.

Le mieux c'est d'ecir le code comme ceci
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Private Sub Worksheet_Change(ByVal Target As Range) ActiveSheet.Shapes.Range(Array("TextBox 8")).Select Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Range("G27") ActiveSheet.Shapes.Range(Array("TextBox 9")).Select Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Range("G3") End Sub

1 pièce(s) jointe(s)

Merci de votre aide c'est gentil d'aider les débutant en vba

Voila le travail encore mille merci goldstar ;)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub Worksheet_Change(ByVal Target As Range)
 
ActiveSheet.Shapes.Range(Array("TextBox 8")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Range("G27")
 
ActiveSheet.Shapes.Range(Array("TextBox 9")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Range("G3")
 
ActiveSheet.Shapes.Range(Array("TextBox 18")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Range("G8")
 
ActiveSheet.Shapes.Range(Array("TextBox 19")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Range("G23")
 
ActiveSheet.Shapes.Range(Array("TextBox 20")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Range("G13")
 
ActiveSheet.Shapes.Range(Array("TextBox 21")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Range("G18")
 
End Sub

est le fichier Pièce jointe 183469