November 24, 2010

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

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
    sCount = ActiveWorkbook.Sheets.Count
    'MsgBox (sCount)
    If MsgBox("Please copy the content and then click on OK", vbOKOnly, "Decision") = vbOK Then
    End If
    sIndex = 1
    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
        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
            End If
        End If
        GoTo askUser
    End If

End Sub

Sub CopyAndFormatData()

'If Range("A1").Font.Bold = True Then
    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
    End If
    'select header row and make it as bold
    Cells(1, 1).EntireRow.Select
    Selection.Font.Bold = True
    'Autofit column width

End Sub

Sub ClearClipboard()
    OpenClipboard (0&)
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
            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
        '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"
                '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
Post a Comment

Featured Post

Java Introdcution

Please send your review and feedback to