Posted to microsoft.public.excel.programming
|
|
To let us choose the file
Hi P45cal!, Interesting to hear that we might be doing 4 clrecks out of a
job, could you give me more explanantion, What do you mean by FrankctoValue
wbCurrent . Do you mean that I will put my macro in that line?
Actually I have tested that coverting the sheet into value is ok, the only
thing left it the VBA to let me choose/open the file/workbook from a folder.
I appreciate your help.
Frank
"p45cal" wrote:
I might be doing 4 clercks (sic) out of a job!
Try this, but test it first and adjust as required.
Sub blah()
Application.ScreenUpdating = False
Dim wbCurrent As Workbook
files_to_open = _
Application.GetOpenFilename("Excel files (*.xls), _*.xls", , , , True)
If Not IsArray(files_to_open) Then
MsgBox "Nothing selected"
Exit Sub
Else
For i = LBound(files_to_open) To UBound(files_to_open)
Set wbCurrent = Workbooks.Open(files_to_open(i))
Application.StatusBar = "Processing " & files_to_open(i)
FrankctoValue wbCurrent 'do stuff here
NewFilename = Left(files_to_open(i), Len(files_to_open(i)) - 4) _
& " - Testing - please delete.xls"
wbCurrent.SaveAs NewFilename
wbCurrent.Close
Next i
End If
Set wbCurrent = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox UBound(files_to_open) - LBound(files_to_open) + _
1 & " files processed (hopefully)."
End Sub
Sub FrankctoValue(myWb As Workbook)
'
' FrankctoValue Macro
' Macro recorded 6/27/2007 by Frank
'
' Keyboard Shortcut: Ctrl+s
'
myWb.Activate
Sheets("PO New (2)").Copy After:=Sheets(2)
'Sheets(1).Copy After:=Sheets(1) ' my testing, Pascal
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Columns("A:AV").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Replace What:="", Replacement:="$", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="$", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Use it by running the macro 'blah', which in turn calls your macro, so don't
use your shortcut, create another one to blah instead if you want.
It will ask you to select one or multiple xls files and process them all.
The files don't need to be open, in fact they shouldn't be open.
Progress can be followed as it will show which file is being processed on
excel's status bar (at the bottom).
I have changed your FrankcToValue macro slightly to take a parameter.
It currently saves the files under a new name, which is the original name
with 'Testing - Please delete' tacked on the end, in the same folder as the
original file. Amend as required.
I did this on XL2003.
Note: I was caught out by a Gotcha with GetOpenFilename, it's unlikely to
affect you if you run blah from a keyboard shortcut. Tom Ogilvy has seen it
before, it's at
http://www.excelforum.com/archive/in.../t-497214.html
Pascal
--
p45cal
"Frank Situmorang" wrote:
Dear Experts:
I want to make an Addin, to perform conversion of worksheet to value which
can be done by 4 clercks. My question is how can we make it LET US CHOOSE the
file, the name of the sheet is the same for all workbooks;
This is my macro which I will make it as an Addin. As you CAN see below, the
clerck will open the worksheet first named(' E10-7-012 -DAIHATSU PAINT.xls").
but this is variable, because there are hundred of files that they will do
the same process, coz I will write again a macro to pick up those values.
Sub FrankctoValue()
'
' FrankctoValue Macro
' Macro recorded 6/27/2007 by Frank
'
' Keyboard Shortcut: Ctrl+s
'
Windows("E10-7-012 -DAIHATSU PAINT.xls").Activate
Sheets("PO New (2)").Copy After:=Sheets(2)
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("A:AV").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Replace What:="", Replacement:="$", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="$", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
I appreciate your precious help.
Frank
|