Excel Pivot Table'da Veri Kaynagini Degistirmek

Varsayalim, bir zaman harici bir veri kaynagindan beslenen bir Excel Pivot Table olusturdunuz. Bir zaman sonra bu veri kaynaginin IPsini , ismini degistirmek zorunda kaldiniz. Ve beklemediginiz bir sey oldu, meger sizin unuttudugunuz, Pivot Table mailden maile dolasarak sagina soluna grafikler eklenerek bircok insan icin operasyonel bir arac haline gelmis ve IP degisikligi ile bir cok insan bu araci kullanamamaya baslamis.

Surpriz ve basagrisi.

Asagidaki scripti kullanicilara dagitip Pivot Table'lardaki data source alanini degistirmek icin yazdim. Not: Calismasi icin Macro Guvenlik Seviyesinde VBScriptlere izin verilmesi lazim.

Kolay Gelsin

'Replace DataSource Name of an Excel Pivot Table
'By Erdal Akbulut
'on 15.01.08

' Get File
Set ObjCDO = CreateObject("UserAccounts.CommonDialog")
InitFSO = ObjCDO.ShowOpen
If InitFSO = False Then
Wscript.Echo "Script Error: Please select a file!"
Wscript.Quit
Else
fName = ObjCDO.FileName
End If
'Clean up
Set ObjCDO = Nothing
Set InitFSO = Nothing

'Open It in Excel
Set objExcel = CreateObject("EXCEL.APPLICATION")
Set objWorkBook = objExcel.Workbooks.Open(fName)

'Save as XML
fXmlName = fName & ".xml"
objWorkBook.SaveAs fXmlName ,46
objWorkBook.Close True

'Clean up
Set objWorkBook = Nothing
Set objExcel = Nothing

'Open XML as Text File for Input
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile (fXmlName, 1, True)

'Get File Content and Replace Server Name
sFileContents = objTextFile.ReadAll
sFileContents = Replace (sFileContents, "OLDSERVERNAME" , "NEWSERVERNAME")

'Clean up
objTextFile.Close
Set objTextFile = Nothing
Set objFSO = Nothing

'Open XML as Text File for Output
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile (fXmlName, 2, True)

'Output XML File with New ServerName
objTextFile.Write(sFileContents)

'Clean up
objTextFile.Close
Set objTextFile = Nothing
Set objFSO = Nothing

'Open XML in Excel
Set objExcel = CreateObject("EXCEL.APPLICATION")
Set objWorkBook = objExcel.Workbooks.Open(fXmlName)

'Save as XLS with New Name
fNewName = fName & "_New.xls"
objWorkBook.SaveAs fNewName
objWorkBook.Close True

'Clean up
Set objWorkBook = Nothing
Set objExcel = Nothing

'Delete XML file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.GetFile (fXmlName)
objTextFile.Delete

'Clean up
Set objTextFile = Nothing
Set objFSO = Nothing