My ChDir Statement doesn't work

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I am looking to write a macro that will save the file (1.xls) in a
specific directory when running. The Macro works well, but if I open an
other file (2.xls) in other Directory, my Macro saves the file in that
Directory.
Here is an example of my Macros:
Sub OK_sttt()
'
' INREG stttV LIST Macro
' Macro recorded 20.03.2006 by emil
'
Workbooks.Open Filename:="E:\SERVIM\livrari dupa inventar\Stoc timp
real.xls"
Windows("Stoc timp real.xls").Activate
Rows("2:15").Select
Selection.Insert Shift:=xlDown
Selection.RowHeight = 18
Windows("sttt.xls").Activate
Range("D13:D26").Select
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
Range("K2").Select
ActiveSheet.Paste
Windows("sttt.xls").Activate
Range("I13:I26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.SmallScroll ToRight:=41
Range("AV2").Select
ActiveSheet.Paste
Windows("sttt.xls").Activate
Range("J13:J26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.SmallScroll ToRight:=-25
Range("AB2").Select
ActiveSheet.Paste
Windows("sttt.xls").Activate
Range("M13:M26").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.Panes(3).Activate
Range("A2").Select
ActiveSheet.Paste
Windows("sttt.xls").Activate
Range("E6:I6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
Range("B2:B15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Windows("sttt.xls").Activate
Range("G4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
Range("J2:J15").Select
ActiveSheet.Paste
Windows("sttt.xls").Activate
Range("K1").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Stoc timp real.xls").Activate
ActiveWindow.WindowState = xlNormal
Range("E2:E15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("sttt.xls").Activate
Range("J13:J26").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Workbooks.Open Filename:= _
"E:\SERVIM\Livrari dupa inventar\FISIER Save As BL.xls"
Windows("sttt.xls").Activate
Windows("FISIER Save As BL.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.WindowState = xlNormal
Range("A2").Select
Selection.Copy
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A2").Select
Application.CutCopyMode = False
Selection.Copy
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Windows("FISIER Save As BL.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.WindowState = xlNormal
Range("B2").Select
Selection.Copy
Windows("sttt.xls").Activate
Range("G4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
ChDir "F:\Livrari dupa inventar\probe1.05.06"
sFilename = Format(Worksheets("Sheet1").Range("g4").Value, "@")
ans = MsgBox("Save file as " & sFilename)
If ans = vbOK Then

ActiveWorkbook.SaveAs Filename:=sFilename
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=2, Collate _
:=True
Windows("FISIER Save As BL.xls").Activate
ActiveWindow.WindowState = xlNormal
ActiveWindow.WindowState = xlNormal
ActiveWorkbook.Close
Workbooks.Open Filename:="E:\SERVIM\livrari dupa inventar\sttt.xls"
Windows("sttt.xls").Activate
ActiveWindow.WindowState = xlMaximized
Range("G4").Select
ActiveCell.FormulaR1C1 = ""
Range("D13:J26").Select
Selection.ClearContents
Range("M13:M26").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-8
Range("E6:I6").Select
ActiveCell.FormulaR1C1 = ""
Range("E6:I6").Select
Range("L1").Select
Selection.Copy
Range("K1").Select
ActiveSheet.Paste
ActiveWorkbook.Save
End If
End Sub
Thanks for any help
Emil
 
Why use ChDir

Incluse the path in sFilename

If you want to use it use also ChDrive

MyPath = "C:\Data"
ChDrive MyPath
ChDir MyPath
 
Back
Top