Copy Paste Pl/Sql developer queried table data and Auto Format the content

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

                  http://office.microsoft.com/en-gb/excel-help/change-macro-security-settings-in-excel-HP010096919.aspx

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