Paste and Auto-format Table records in Excel
While taking backup of the tables, we are doing the following steps.
1. Executing the query
2. Copying the content from pl/sql developer
3. Opening excel and paste the copying content
4. If we want multiple tables to take backup, we need select next sheet and paste the content
5. If we need more than 3 sheets we are adding new sheets.
6. Just copying content from the pl/sql developer doesn’t finish our work, am I right?
7. We need to format the data too.
So, I just tried to create one auto-formatter which will paste the data and auto-format the data.
Please download the attachment and unzip the file.
After opening the excel file, do the following.
a) Please change the macro settings to "Disable all macros with notification"
Note: To see how you can change the macro settings, please see the following link
b) Please click on the "User Friendly Formatter" button and follow the procedure.
c) It will open a new file and asks you to save the file.
d) Copy the content from pl/sql developer, when it displayed the following pop-up window.
e) The data will be auto formatted and then asks user for continuation by displaying the following window.
f) If user wants to continue, user can click “Yes” button, and the next sheet will be auto-selected.
g) Goto step (d)
h) When your clicks on “No” button, the file will be autosaved.
Please see the macro code and change according to your requirements.
Source Code:
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Sub CreateNewWorkbook()
Dim oWorkbook As Workbook
Dim wbName, fileSaveName As String
Dim sCount, decision, copied, sIndex As Integer
Dim oSheet As Worksheet
'On Error GoTo errHandler
Set oWorkbook = Workbooks.Add
Save_ActiveWorkbook
sCount = ActiveWorkbook.Sheets.Count
'MsgBox (sCount)
If MsgBox("Please copy the content and then click on OK", vbOKOnly, "Decision") = vbOK Then
CopyAndFormatData
End If
sIndex = 1
askUser:
decision = MsgBox("Do you want to continue with the next sheet?", _
vbYesNo, "Decision")
'If user wants to continue
If decision = vbYes Then
'Asking user to copy the data first
copied = MsgBox("Please copy the content and then click on OK", vbOKCancel, "Decision")
'If user copied data
If copied = vbOK Then
'Selecting next sheet
If sIndex < 3 Then
Sheets(sIndex + 1).Select
sIndex = sIndex + 1
'ElseIf sIndex = 3 Then
' Sheets(sIndex).Select
'Adding additional sheet from sheet4
ElseIf sIndex >= 3 Then
Set oSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
End If
'copying and formatting data
CopyAndFormatData
ElseIf copied = vbCancel Then
'Confirm the user whether user want to quit and save file
If MsgBox("Do you want to remain in the same sheet", vbOKOnly, "Save File") = vbOK Then
Sheets(ActiveSheet.Index).Select
End If
End If
GoTo askUser
End If
savingFile:
ActiveWorkbook.Save
End Sub
Sub CopyAndFormatData()
'If Range("A1").Font.Bold = True Then
ActiveSheet.Range("A1").Select
On Error Resume Next
ActiveSheet.PasteSpecial Format:=Text, Link:=False, DisplayAsIcon:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
If Range("A1").Value Is Null Then
Range("A:A").Delete
End If
'select header row and make it as bold
Cells(1, 1).EntireRow.Select
Selection.Font.Bold = True
'Autofit column width
Range("A1").CurrentRegion.Select
Selection.Columns.AutoFit
ClearClipboard
End Sub
Sub ClearClipboard()
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
End Sub
Sub Save_ActiveWorkbook()
'Working in Excel 2000-2010
Dim fname As Variant
Dim NewWb As Workbook
Dim FileFormatValue As Long
'Check the Excel version
If Val(Application.Version) < 9 Then Exit Sub
If Val(Application.Version) < 12 Then
'Only choice in the "Save as type" dropdown is Excel files(xls)
'because the Excel version is 2000-2003
fname = Application.GetSaveAsFilename(InitialFileName:="", _
filefilter:="Excel Files (*.xls), *.xls", _
Title:="Save As the Workbook as ")
If fname <> False Then
'Copy the ActiveSheet to new workbook
ActiveSheet.Copy
Set NewWb = ActiveWorkbook
'We use the 2000-2003 format xlWorkbookNormal here to save as xls
NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
NewWb.Close False
Set NewWb = Nothing
End If
Else
'Give the user the choice to save in 2000-2003 format or in one of the
'new formats. Use the "Save as type" dropdown to make a choice,Default =
'Excel Macro Enabled Workbook. You can add or remove formats to/from the list
fname = Application.GetSaveAsFilename(InitialFileName:="", filefilter:= _
" Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
" Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
" Excel 2000-2003 Workbook (*.xls), *.xls," & _
" Excel Binary Workbook (*.xlsb), *.xlsb", _
FilterIndex:=1, Title:="Save As the Workbook as ")
'Find the correct FileFormat that match the choice in the "Save as type" list
If fname <> False Then
Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
Case "xls": FileFormatValue = 56
Case "xlsx": FileFormatValue = 51
Case "xlsm": FileFormatValue = 52
Case "xlsb": FileFormatValue = 50
Case Else: FileFormatValue = 0
End Select
'Now we can create/Save the file with the xlFileFormat parameter
'value that match the file extension
If FileFormatValue = 0 Then
MsgBox "Sorry, unknown file extension"
Else
'Copies the ActiveSheet to new workbook
Set NewWb = ActiveWorkbook
'Save the file in the format you choose in the "Save as type" dropdown
NewWb.SaveAs fname, FileFormat:= _
FileFormatValue, CreateBackup:=False
End If
End If
End If
End Sub
Note: Please send your feedback and comments
