Macro sauvegarder avec demande du chemin

Résolu/Fermé
Mister-t - 10 juin 2008 à 13:20
 mister-t - 11 juin 2008 à 13:16
Bonjour,

Voila j'ai un petit problème avec ma macro,. Comme vous pouvez le voir sur ma macro je fais une copie de cellules sur un classeur WBK2 a partir d'un autre WBK1. Ensuite je sauvegarde WBK2 et je le ferme ce qui me fais revenir sur WBK1.
Ma question est la suivante: je desirerais enregistrer WBK1 mais il faudrait que excel me demande a quel endroit je souhaite le sauver? cette solution me semble la plus simple

Ma deuxième question est: j'ai essayé de faire une auto copy sauvegarde de WBK1 et le chemin de destination est

C:Documents and settings\MARTINR\Mes documents\PV dimension (h)

toutefois le (h) fait intervenir le deboggueur car il ne trouve pas le chemin. En fait je veux que le h corresponde au h declaré en debut de programme et fait reference a une textbox ?

Voila si vous pouvez m'aider je vous en remercie

Sub macro1()
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim h As String
Dim x, y, z As Integer


Set wbk1 = ThisWorkbook

h = UserForm1.TextBox2.Text
x = Cells(6, 11).Value
y = 4
z = x + y

Set wbk2 = Workbooks.Open(FileName:="dimensi.1998 a 2008")

wbk2.Sheets(h).Cells(z, 1) = wbk1.Sheets("PV").Cells(6, 11)

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Font.Bold = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection.Font
.name = "Times New Roman"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Selection.Font.ColorIndex = 0



wbk2.Sheets(h).Cells(z, 2) = wbk1.Sheets("PV").Cells(16, 5)

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Font.Bold = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection.Font
.name = "Times New Roman"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Selection.Font.ColorIndex = 0


wbk2.Sheets(h).Cells(z, 3) = wbk1.Sheets("PV").Cells(9, 3)

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Font.Bold = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection.Font
.name = "Times New Roman"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Selection.Font.ColorIndex = 0

wbk2.Sheets(h).Cells(z, 4) = wbk1.Sheets("PV").Cells(16, 15)


Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Font.Bold = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection.Font
.name = "Times New Roman"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Selection.Font.ColorIndex = 3

wbk2.Sheets(h).Cells(z, 5) = wbk1.Sheets("PV").Cells(34, 8)


Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Font.Bold = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection.Font
.name = "Times New Roman"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Selection.Font.ColorIndex = 0

Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.DisplayAlerts = True


Dim copyname As String
copyname = Range("numeroPV")
ChDir "C:Documents and settings\MARTINR\Mes documents\PV dimension (h)"
wbk1.SaveCopyAs copyname





End Sub
A voir également:

4 réponses

yg_be Messages postés 22698 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 18 avril 2024 1 471
10 juin 2008 à 13:54
ChDir "C:Documents and settings\MARTINR\Mes documents\PV dimension (" & h & ")"
0
je suis desolé mais ça ne marche pas

erreur d'execution 76
chemin introuvable

peut tu detailler un peu plus
0
Mister-t > Mister-t
10 juin 2008 à 15:08
je represise mon problème

mon chemin de destination n'est pas correct, il faut juste modifier ce que tu m'a donné

wbk1.SaveCopyAs FileName:="C:\Documents and Settings\MARTINR\Mes documents\PV dimension (" & h & ")\" & copyname

en fait le dossier de destination s'appelle PV dimension (et le numero ecrit par l'utilisateur qui correspond au h)
0
yg_be Messages postés 22698 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 18 avril 2024 1 471
10 juin 2008 à 15:24
quelle est la situation maintenant ?
0
bonjour

excuse moi pour ce delai je ne travaille pas à la maison

la situation es maintenant que le bout de code qui est en noir ne fonctionne pas, il ne trouve pas le chemin specifié

il devrait trouver un chemin du genre

C:\Documents and Settings\MARTINR\Mes documents\PV dimension 2008\" & copyname

2008 etant la textbox qui correspond a la lettre d'attribution h

voila j'espere avoir bien expliqué les choses
0
yg_be Messages postés 22698 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 18 avril 2024 1 471
11 juin 2008 à 11:01
et ainsi :
wbk1.SaveCopyAs FileName:="C:\Documents and Settings\MARTINR\Mes documents\PV dimension " & h & "\" & copyname

j'avais laissé les parenthèses, je pensais qu'elle devaient faire partie du nom...
0
Re salut yg_be

Merci pour cette ligne de macro. Cela marche parfaitement. Je te remercie

Ton aide a été très précieuse !!!
0
problème resolu
0