Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all 88854 articles
Browse latest View live

Need to insert variables to iterate over an SAP table using a vbs script. Error "list delimiter" or ")" missing keeps coming up. What am I missing?

$
0
0

'I have iterated over tables in SAP in the past but, I can't figure out 'what's different in the following code.

Dim Row_Numb
Dim i_col
Dim j_col
Dim k_col


Row_Numb = 0
i_col = 0
j_col = 1
k_col = 2

While items_in_class <> ""
      i_col = CStr(i_col)
      j_col = CStr(j_col)
      k_col = CStr(k_col)

'Original line from Script recording. This works
'Cells(6, 3).Value = SapSession.FindById("wnd[0]/usr/tabsTABSTR/tabpMERK/ssubSUB:SAPLCLMO:0130/tblSAPLCLMOMERKMAL/txtRMCLM-SMERKB[1,1]").Text

'Replacing [1,1] with variables Row_Num and variable to iterate. It doesn't work
Cells(6, 3).Value = SapSession.FindById("wnd[0]/usr/tabsTABSTR/tabpMERK/ssubSUB:SAPLCLMO:0130/tblSAPLCLMOMERKMAL/txtRMCLM-SMERKB["&Row_Numb&"."&i_col&"]").Text

VBA Merge Similar Cells

$
0
0

I would like to merge similar cells by columns, as of now I am using this macro

Sub MergeSimilarCells()

    Set myRange = Range("A1:Z300")

CheckAgain:
    For Each cell In myRange
        If cell.Value = cell.Offset(0, 1).Value And Not IsEmpty(cell) Then
            Range(cell, cell.Offset(0, 1)).Merge
            cell.VerticalAlignment = xlCenter
            cell.HorizontalAlignment = xlCenter
            GoTo CheckAgain
        End If
    Next

End Sub

My problem is with hundreds of rows and 40-50 columns, it takes forever. I am pretty sure a For Loop could help me there but I am not skilled enough to figure it out

I know the following code is wrong but I am lost

Sub SimilarCells()
  Set myRange = Range("A1:G4")
    Dim count As Integer

CheckAgain:
    count = 1

    For Each cell In myRange
        If cell.Value = cell.Offset(0, 1).Value And Not IsEmpty(cell) Then
            count = count + 1

        ElseIf cell.Value <> cell.Offset(0, 1).Value Then
            Range(cell, cell.Offset(0, -count)).Merge
        End If
    Next

End Sub

Excel example data

Here is what I would like to accomplish

Final Result

VBA to paste shapes transposed in Excel 2007?

$
0
0

When I pasted cells transposed, the pictures were not pasted.

Is this normal for excel?

If so is there any code or trick to get those pictures (which are column/row headers!) Transposed from the old row to the new column?

Many thanks

enter image description here

How to apply a vba macro to all excel files in a folder?

$
0
0

I would like to delete a worksheet on multiple excel workbooks. I already have some VBA code to delete a worksheet in a single file:

Sub delete_sheet()
Application.DisplayAlerts = False
For Each aSheet In Worksheets
    Select Case aSheet.Name
        Case "INV."
            aSheet.Delete
    End Select

    Next aSheet
    Application.DisplayAlerts = True
End Sub

I have 500 files in my folder all needed to delete a tab named "INV.". How do I apply this operation to all the files within my folder? I have tried the example provided from this website: https://analystcave.com/vba-run-macro-on-all-files-in-a-folder-all-worksheets-in-a-workbook/:

Sub RunOnAllFilesInFolder()
    Dim folderName As String, eApp As Excel.Application, fileName As String
    Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
    Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Set currWb = ActiveWorkbook: Set currWs = ActiveSheet

    'Select folder in which all files are stored
    fDialog.Title = "Select a folder"
    fDialog.InitialFileName = currWb.Path
    If fDialog.Show = -1 Then
      folderName = fDialog.SelectedItems(1)
    End If


    'Create a separate Excel process that is invisibile
    Set eApp = New Excel.Application:  eApp.Visible = False

    'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
    fileName = Dir(folderName & "\*.*")
    Do While fileName <> ""'Update status bar to indicate progress
        Application.StatusBar = "Processing "& folderName & "\"& fileName

        Set wb = eApp.Workbooks.Open(folderName & "\"& fileName)

'I tried placing my code here
Sub delete_sheet()
Application.DisplayAlerts = False
For Each aSheet In Worksheets
    Select Case aSheet.Name
        Case "INV."
            aSheet.Delete
    End Select

    Next aSheet
    Application.DisplayAlerts = True
End Sub

        wb.Close SaveChanges:=True 'Close opened worbook w/o saving, change as needed
        Debug.Print "Processed "& folderName & "\"& fileName 
        fileName = Dir()
    Loop
    eApp.Quit
    Set eApp = Nothing
    'Clear statusbar and notify of macro completion
    Application.StatusBar = ""
    MsgBox "Completed executing macro on all workbooks"
End Sub

It crashed my excel when I try to execute it. Any suggestions?

Exporting .xlsx and .pdf where filename already exists

$
0
0

I need some basic help that I can't get right in my code.

Saving as both an .xlsx and PDF file, in the same location, just can't get it to prompt if filename already exists

Sub SaveAs()
Dim Path As String
Dim filename As String
Path = "C:\Users\yard\Dropbox\Modus\Purchase Orders\"
filename = Range("E4")
            Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs filename:=Path & filename & ".xls", FileFormat:=xlOpenXMLWorkbook

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=Path & filename & ".pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

End Sub

Or have I cancelled that out by using Application.DisplayAlerts = False?

I don't want to be prompted regarding a macro enabled workbook when saving the excel file, however I would like it to prompt if the filename already exists.

Building frequency table using tick by tick data

$
0
0

I am trying to calculate the conditional probability of upmove (price going up) given that the previous price movement has been up or down. This is based on transition matrix obtained in the following paper: https://www.jstor.org/stable/2283188?seq=1#metadata_info_tab_contents

The raw tick by tick data looks like this:

Stock V3 V4 V5 V6 date

A EQ 9:07:41 115.95 100 2016/01/01

A EQ 9:07:41 115.95 200 2016/01/01

A EQ 9:07:42 116 200 2016/01/01

I need to calculate probabilities using frequency table. The required probability is Pr (Price(at transaction-t) | Price(at transaction-t-1), (at transaction-t-2).......)

This sequence can vary from 1 to 10.

It'd be great if someone can help me provide the logic for how to form the transition matrix like shown in paper for different sequences varying from 1 to 10. The paper shows sequence of length 2.

Cleaning up Data using a VBA Macro

$
0
0

I have a basic request. Yet I can't seem to find anything on here that really helps me.

I'm trying to do some basic data clean up. I'm very new at VBA. So I recorded a macro that cleans up the data for me.

However it's for thousands of rows of data, and my macro only works on the first few rows. I've created a basic form of what my data looks like.

Range("A8").Select
Selection.Copy
Range("A2").Select
ActiveSheet.Paste
Range("A10").Select
Application.CutCopyMode = False
Selection.Copy
Range("A10").Select
Application.CutCopyMode = False
Selection.Copy
Range("B2").Select
ActiveSheet.Paste
Range("A12").Select
Application.CutCopyMode = False
Selection.Copy
Range("C2").Select
ActiveSheet.Paste
Range("A14").Select
Application.CutCopyMode = False
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Range("A14").Select
Application.CutCopyMode = False
Selection.Copy
Range("D2").Select
ActiveSheet.Paste
Range("A17").Select
Application.CutCopyMode = False
Selection.Copy
Range("A3").Select
ActiveSheet.Paste
Range("A19").Select
Application.CutCopyMode = False
Selection.Copy
Range("B3").Select
ActiveSheet.Paste
Range("A21").Select
Application.CutCopyMode = False
Selection.Copy
Range("C3").Select
ActiveSheet.Paste
Range("A23").Select
Application.CutCopyMode = False
Selection.Copy
Range("D3").Select
ActiveSheet.Paste

I'd like this to continue working. This is the example format for my data. Name/Comments/Date/Cost <- Header columns

The following data is all in the same 'A' column.

john

Hello

9/12/1999

62


Tim

Yup

9/13/1999

623

Betty

Right on

9/14/1999

52

Thanks for any help on this. ~Signed~ The VBA Noob

vba to collapse pivot table detail for prior years

$
0
0

I have a workbook with about 120 tabs, each containing one or two pivot tables. The pivot tables are updated and refreshed monthly. I am struggling to write a macro that will collapse all prior year data.

This code works, but I would need to update it and re-run it for each prior year:

Dim ws As Worksheet
Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "1"& "*" Or ws.Name Like "2"& "*" Or ws.Name Like "3"& "*" Then
        ws.PivotTables("PivotTable1").PivotFields("Years").PivotItems("2015"). _
            ShowDetail = False
        On Error Resume Next
        ws.PivotTables("PivotTable2").PivotFields("Years").PivotItems("2015"). _
            ShowDetail = False
    End If
Next ws
End Sub

I would prefer code that can collapse all prior year data.

I have tried the following, and it produces a run-time error 438 object doesn't support this property or method:

Dim ws As Worksheet
Dim datecell As Range
Dim cy As Long

Application.ScreenUpdating = False

Set datecell = ThisWorkbook.Worksheets("Index").Range("H1")
cy = Year(datecell)

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "1"& "*" Or ws.Name Like "2"& "*" Or ws.Name Like "3"& "*" Then
        'the following line produces the run-time 438 object doesn't support this property or method error
        If Year(ws.PivotTables("PivotTable1").PivotFields("Years").PivotItems) < cy Then
            PivotItem.ShowDetails = False
        End If
    End If
Next ws
End Sub

I have also tried the following, and it produces a run-time error 13 type mismatch:

Dim ws As Worksheet
Dim datecell As Range
Dim cy As Long

Application.ScreenUpdating = False

Set datecell = ThisWorkbook.Worksheets("Index").Range("H1")
cy = Year(datecell)

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "1"& "*" Or ws.Name Like "2"& "*" Or ws.Name Like "3"& "*" Then
        For Each PivotItem In ws.PivotTables("PivotTable1").PivotFields("Years").PivotItems
            'the following line produces the run-time 13 type mismatch error
            If Year(PivotItem) < cy Then
                PivotItem.ShowDetails = False
            End If
        Next PivotItem
    End If
Next ws
End Sub

Does anyone know how to correct my code? Thanks!

Edit 1: The following code produces a run-time error 438: Object doesn't support this property or method:

Dim ws As Worksheet
Dim pt As PivotTable
Dim ptItm As PivotItem
Dim datecell As Range
Dim cy As Long
Dim ptItmY As Long

Application.ScreenUpdating = False

Set datecell = ThisWorkbook.Worksheets("Index").Range("H1")
cy = Year(datecell)

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "1"& "*" Or ws.Name Like "2"& "*" Or ws.Name Like "3"& "*" Then
        For Each pt In ws.PivotTables
            For Each ptItm In pt.PivotFields("Years").PivotItems
                ptItmY = Right(ptItm, 4)
                If ptItmY < cy Then
                    'the following line produces run-time error 438: Object doesn't support this property or method
                    ptItm.ShowDetails = False
                    Else: ptItm.ShowDetails = True
                End If
            Next ptItm
        Next pt
    End If
Next ws
End Sub

Uploaded image of a pivot table: Pivot table format


How to embed an image into an Outlook email using VBA

$
0
0

Very closely related to Embed picture in outlook mail body excel vba

I'm trying to embed an image into an Outlook email.

I'm using the following code snippet, half of which has been stolen from the post above:

Sub PictureEmail()
    Dim outApp As New Outlook.Application
    Dim OutMail As Object
    Dim Attchmnt As String
    Dim Signature As String
    Dim WB As Workbook
    Set WB = ThisWorkbook
   Attchmnt = "C:\Users\Blah\Painted_Lady_Migration.jpg"


    Set OutMail = outApp.CreateItem(0)
    On Error Resume Next
    With OutMail
    .To = WB.Names("to").RefersToRange.Value2
    .CC = WB.Names("cc").RefersToRange.Value2
    .BCC = WB.Names("bcc").RefersToRange.Value2
    .Subject = WB.Names("Subject").RefersToRange.Value2
   .HTMLBody = "<img src=""cid:Painted_Lady_Migration.jpg""height=520 width=750>"
   .display
   End With

   If Attchmnt = "" Then
   Else
   OutMail.Attachments.Add Attchmnt
   End If

   On Error GoTo 0

End Sub

However, when looking at the generated email, I have the error "The linked image cannot be displayed. The file may have been moved, renamed, or deleted".

I've tried a few different ways to attach the file, including:

.HTMLBody = "<img src="& Chr(34) & "cid:Painted_Lady_Migration.jpg"& Chr(34) & "height=520 width=750>"

I just can't get it to work >_<

I saw somewhere that spaces in the name/filepath can throw it, so I replaced the spaces in the name with underscores

What dumb thing am I forgetting/missing?

VBA Macro got me stumped

$
0
0

I'm using a macro to make a copy of the active sheet, and rename it to whatever the value of cell 'C2' is. The only problem is, that when it copies the sheet, it somehow removes the form buttons from the top of my worksheet and replaces them with the code =$c$2 in cell 'AF'.

As far as i can see from the VBA code there is nothing that refers to the cell 'AF'. Can anyone tell me why it's doing this ?

Sub Copy_Rename()
    Dim shtName As String
    shtName = ActiveSheet.Name
    ActiveSheet.Copy before:=ActiveSheet
    ActiveSheet.Name = Range("C2").Value
    Sheets(shtName).Activate
End Sub

Using a macro to generate a table with a defined number of rows in excel

$
0
0

I am trying to generate a table in excel using a number of rows defined elsewhere in the sheet with a macro button. For example, if I define the number 7 in cell Q2, I'd like to be able to generate a table with a range from Q3:V9. The table will always have 6 columns, but will vary with the number of rows. Thus, if I change that 7 to an 8, the range would instead be defined at Q3:V10.

How to use a VBA to combine rows that are prematurely broken from a CSV?

$
0
0

I have a CSV showing purchase information, but in each line the data must have too many commas as a few extra breaks are added in. In this case, row 1 is the header. Rows 2-5 should be merged into one, and the blank row 6 shouldn't exist. Here's what the data looks like in the "Get Data" feature in Excel before being input

enter image description here

I think the solution provided here is close to what I need to do, but as someone who's never written a Macro I was wondering if someone can provide a more specific solution. https://superuser.com/questions/395126/how-to-combine-values-from-multiple-rows-into-a-single-row-in-excel

Copy files FromPath to 3 other folders using the state abbreviations in the file name as the variable to determine ToPath location

$
0
0

I am currently working on a macro to copy pdf files in one master folder to several other locations. There is a segment of this macro where the various files need to be copied to 3 different folders according to the State abbreviations in the file name.

For instance; files containing AZ, CA, CO, and NM need to be put in the "Main" folder. Files containing FL need to go in the "FL" folder and all other state abbreviations need to go in the "Secondary" folder.

I am having trouble finding a way to list multiple state abbreviation variables at once and moving those files. I will provide the code I am working with below. Thank you!

Sub Copy_Certain_Files_In_Folder()

    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileName As String

    FromPath = "C:\Users\Name\Desktop\Master File"'<< Change
    ToPath = "C:\Users\Name\Desktop\SharePoint\Main"'<< Change

    FileName = "DOC-AZ*" Or "DOC-CA*" Or "DOC-CO*" Or "DOC-NM*"

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
        End If

    If FSO.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If

    FSO.CopyFile Source:=FromPath & FileName, Destination:=ToPath

    MsgBox "You can find the files from "& FromPath & " in "& ToPath

End Sub

Need to send CPU and Memory information to Excel sheet

$
0
0

I am automating health check for some of the windows servers. I am very new to PowerShell (started today).

I want the CPU and Memory utilization of a windows server at an instant to be recorded in an Excel workbook in different sheets. After googling and following the documents, I have found the commands to retrieve this data using Win32_processor and win32_operatingsystem classes.

I am using Export-CSV cmdlet which directly copies the output to the excel.

I am using New-Object cmdlet and created a psobject to get both the outputs added to the property and then pasted in excel.

$Memory = gwmi win32_operatingsystem | Select-Object @{Name = "MemoryUsage"; Expression = {"{0:N2}" -f ((($_.TotalVisibleMemorySize - $_.FreePhysicalMemory)*100)/ $_.TotalVisibleMemorySize) }}
$CPU = gwmi win32_processor | Measure-Object -property LoadPercentage -Average | Select Average
$Props = @{"Memory"= $Memory ; "CPU Utilization" = $CPU}
$Mydata = New-Object -TypeName psobject -Property $Props
$MYdata | Export-Csv C:\Users\Mitu\Desktop\output-excel.csv -nti

Any other way to get this things done?

Also, I want to send this csv to our email id. What things are required to achieve this via powershell?

VBA webscrapping English premier League form

$
0
0

Am trying to scrap form data(last 6 games played) but its not coming out the way I want.The form column shows green (Win), Orange(Draw) and Lose(Red).I would like to see the team first and the form like below:

for example, Liverpool WWWWDL

Below is the code that I have used

Sub ELPForm()

    'dimension (set aside memory for) our variables
    Dim objIE As InternetExplorer
    Dim ele As Object
    Dim y As Integer

    'start a new browser instance
    Set objIE = New InternetExplorer
    'make browser visible
    objIE.Visible = False

    'navigate to page with needed data
    objIE.navigate "https://www.soccerstats.com/latest.asp?league=england"'wait for page to load
    Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop

    'we will output data to excel, starting on row 1
    y = 1


    For Each ele In objIE.document.getElementById("btable").getElementsByTagName("tr")
        'show the text content of 'tr' element being looked at
        Debug.Print ele.textContent
        'each 'tr' (table row) element contains 4 children ('td') elements
        Sheets("Sheet1").Range("A"& y).Value = ele.Children(0).textContent
        Sheets("Sheet1").Range("B"& y).Value = ele.Children(1).textContent
        Sheets("Sheet1").Range("D"& y).Value = ele.Children(10).textContent
        'increment row counter by 1
        y = y + 1
    'repeat until last ele has been evaluated
    Next


End Sub

Trying to remove bad data using countif function

$
0
0

First, thank you for the help in solving this problem. It's pretty simple but I'm just not getting it.

In excel, I have 2 tabs. In the first tab, I have rows of personel data (job title, country of business, Industry, etc.)

In the second tab, I have a column of prohibited titles. These are titles that don't match the criteria we want.

I'd like to create a formula that checks the rows in tab 1 against the prohibited titles in tab 2. If the data matches, I'd like it to return 'N' in column A, which signals that we should remove that row of data. Title information is found in row F on tab 1.

My various countif functions aren't working and I'm not sure why.

Various countif formulas, like

=COUNTIF(F:F,"'Bad Titles!'A:A")

Produces N for all titles we want to disregard

Print Range User Selected VBA Excel

$
0
0

I was hoping to create a module that would basically operate like so:

  1. Define 4 or 5 print ranges;
  2. Prompt a user an input box;
  3. Allow the user to select, from a drop down in that input box, the range they wish to print;
  4. After selecting the range, they hit OK, and are prompted by a "are you sure?" box to prevent mistaken clicks.

I'm fairly lost on this and I honestly feel like the code I've been writing will be less help than just articulating the problem.

I have had it work by the user defining the range (manually selecting the columns they wish to print), but that's not what I'm looking for.

One step further, would it be possible to allow for the customization of the print format (landscape vs portrait, and paper type) even further?

Thanks so much for the help in advance, I'll do my best to answer questions and provide samples of the code I referenced above (just a prompt that allows you to select the columns. I need it to be a defined range, by name, range1=a2:c14 or something like that, because the end user is not a great excel user.

See below:

Sub SelectPrintArea()
Dim PrintThis As Range
ActiveSheet.PageSetup.PrintArea = ""
Set PrintThis = Application.InputBox _
(Prompt:="Select the Print Range", Title:="Select", Type:=8)
PrintThis.Select
Selection.Name = "NewPrint"
ActiveSheet.PageSetup.PrintArea = "NewPrint"
ActiveSheet.PrintPreview
End Sub

As a follow-up:

Assume the document has hidden sections, would it be able to unhide those sections if they are part of a user defined range (like if it was part of a grouping). Would this work on a protected document?

Trying to make a program that takes multiple spreadsheets from multiple workbooks and merge them with there equivalent in the other workbooks

$
0
0
import pandas as pd
 from os import listdir

 from os.path import isfile , join

folder = "c:/sheets"

excel_names = [f for f in listdir(folder) if isfile(join(folder, f))]
 print(excel_names)
 excel_files = []
for item in excel_names:
 item = folder + item excel_files.append(item)
 # read them in
excels = [pd.ExcelFile(name) for name in excel_files]
# turn them into dataframes
 frames = [x.parse(x.sheet_names[0], header=None, index_col=None) 
for x in excels]
# delete the first row for all frames except the first
#  i.e. remove the header row -- assumes it's the first

 frames[1:] = [df[1:] for df in frames[1:]]
# concatenate them..
 combined = pd.concat(frames) combined.to_excel(folder+"/combined.xlsx", header=False, index=False)

This is the code I wrote so far but it seems to work for one sheet only in multiple workbook. What should I do?

SendKeys Not Capturing all Data

$
0
0

I'm using VBA code to take data from excel and populate a pdf from using SendKeys. This works for 99% of all of my data, but I'm noticing in some instances, the data from excel is not fully transferring to the PDF.

For example, in cell D3, I have the text "17.04% / 17.84%" (note- this is a text field, so minus the quotes, this is exactly how the text is formatted).

When I run this code:

Application.SendKeys Sheet10.Range("D3").Value, True
Application.Wait Now + 0.00001

The result is "17.04", leaving the percentage signs and the other half of the text.

I know that sendkeys is known to be problematic, so is there an alternative way of transferring excel data to pdf?

If not, is there a way to have the sendkeys capture the full text? I tried adding the "Application.Wait Now + 0.00001" but this doesn't seem to solve the issue.

Jexcel - Updating an excel with data

$
0
0

I've tried using Jexcel

to update an existing excel sheet as discussed in the Vogella tutorial.

Issue here is the data already present in the existing excel sheet is wiped out with the newly written excel data.

For example if I've this in the excel

<table>
<tr>
<td>1</td> <td>2 </td>
</tr>
<tr>
<td>3</td> <td>4 </td>
</tr>
<table>

and I want to add data to the new cell next to 2 and 4, like

<table>
<tr>
<td>1</td> <td>2 </td> <td>X </td>
</tr>
<tr>
<td>3</td> <td>4 </td> <td>Y </td>
</tr>
<table>

after the write program executed this is what I get

<table>
<tr>
<td> </td> <td>  </td> <td>X </td>
</tr>
<tr>
<td> </td> <td>  </td> <td>Y </td>
</tr>
<table>

Label label;
label = new Label(column, row, s, times);
sheet.addCell(label);

This is adding the cell at the specified column and row but wiping out the rest of the excel data.

How can I add data to the existing excel keeping the data?

Following is the program(Reference: Vogella). Excel sheet already has data in 20 rows and first 2 columns, am trying to add data on the 3rd column for 20 rows package excel;

import java.io.File;
import java.io.IOException;
import java.util.Locale;

import jxl.CellView;
import jxl.Workbook;
import jxl.WorkbookSettings;
import jxl.format.UnderlineStyle;
import jxl.write.Label;
import jxl.write.WritableCellFormat;
import jxl.write.WritableFont;
import jxl.write.WritableSheet;
import jxl.write.WritableWorkbook;
import jxl.write.WriteException;
import jxl.write.biff.RowsExceededException;

public class WriteExcel {

    private WritableCellFormat timesBoldUnderline;
    private WritableCellFormat times;
    private String inputFile;

    public void setOutputFile(String inputFile) {
        this.inputFile = inputFile;
    }

    public void write() throws IOException, WriteException {
        File file = new File(inputFile);
        WorkbookSettings wbSettings = new WorkbookSettings();

        wbSettings.setLocale(new Locale("en", "EN"));

        WritableWorkbook workbook = Workbook.createWorkbook(file, wbSettings);
        workbook.createSheet("Report", 0);
        WritableSheet excelSheet = workbook.getSheet(0);
        createLabel(excelSheet);
        createContent(excelSheet);

        workbook.write();
        workbook.close();
    }

    private void createLabel(WritableSheet sheet) throws WriteException {
        // Lets create a times font
        WritableFont times10pt = new WritableFont(WritableFont.TIMES, 10);
        // Define the cell format
        times = new WritableCellFormat(times10pt);
        // Lets automatically wrap the cells
        times.setWrap(true);

        // Create create a bold font with unterlines
        WritableFont times10ptBoldUnderline = new WritableFont(
                WritableFont.TIMES, 10, WritableFont.BOLD, false,
                UnderlineStyle.SINGLE);
        timesBoldUnderline = new WritableCellFormat(times10ptBoldUnderline);
        // Lets automatically wrap the cells
        timesBoldUnderline.setWrap(true);

        CellView cv = new CellView();
        cv.setFormat(times);
        cv.setFormat(timesBoldUnderline);
        cv.setAutosize(true);

    }

    private void createContent(WritableSheet sheet) throws WriteException,
            RowsExceededException {

        Integer salary = 1000;
        // Now a bit of text
        for (int i = 0; i < 20; i++) {
            // third column
            addLabel(sheet, 2, i, salary.toString());

            // WritableCell cell = sheet.getWritableCell(2, i);
            // if (cell.getType() == CellType.LABEL) {
            // Label l = (Label) cell;
            // l.setString("modified cell");
            // }
            salary += 1000;
        }

    }

    private void addLabel(WritableSheet sheet, int column, int row, String s)
            throws WriteException, RowsExceededException {
        Label label;
        label = new Label(column, row, s, times);
        sheet.addCell(label);
    }

    public static void main(String[] args) throws WriteException, IOException {
        WriteExcel test = new WriteExcel();
        test.setOutputFile("c:/temp/lars.xls");
        test.write();
        System.out
                .println("Please check the result file under c:/temp/lars.xls ");
    }
}
Viewing all 88854 articles
Browse latest View live