Connecting Tech Pros Worldwide Forums | Help | Site Map

Export Data to Excel

Jonny
Guest
 
Posts: n/a
#1: Nov 13 '05
Hello,

I have created a button on my form which when pressed does the
following :

1) Run a pre-defined Macro, which is picking up a query and running my
data to excel.

However, I need the data to export into Excel in a certain format, i.e
it needs to begin importing at cell A4, and in truth it would be great
if I could get the data to populate a pre-designed excel worksheet.

would anyone be able to help me do this please ?

Thanks,

J.

PC Datasheet
Guest
 
Posts: n/a
#2: Nov 13 '05

re: Export Data to Excel


Export your data into a standard worksheet and in your pre-designed excel
worksheet use formulas to get the data from that worksheet.

--
PC Datasheet
Your Resource For Help With Access, Excel And Word Applications
resource@pcdatasheet.com
www.pcdatasheet.com


"Jonny" <jonnymenthol@yahoo.com> wrote in message
news:14f4e726.0406210652.1dfb7ead@posting.google.c om...[color=blue]
> Hello,
>
> I have created a button on my form which when pressed does the
> following :
>
> 1) Run a pre-defined Macro, which is picking up a query and running my
> data to excel.
>
> However, I need the data to export into Excel in a certain format, i.e
> it needs to begin importing at cell A4, and in truth it would be great
> if I could get the data to populate a pre-designed excel worksheet.
>
> would anyone be able to help me do this please ?
>
> Thanks,
>
> J.[/color]


Mr. Smith
Guest
 
Posts: n/a
#3: Nov 13 '05

re: Export Data to Excel


Jonny wrote:
[color=blue]
> Hello,
>
> I have created a button on my form which when pressed does the
> following :
>
> 1) Run a pre-defined Macro, which is picking up a query and running my
> data to excel.
>
> However, I need the data to export into Excel in a certain format, i.e
> it needs to begin importing at cell A4, and in truth it would be great
> if I could get the data to populate a pre-designed excel worksheet.
>
> would anyone be able to help me do this please ?
>
> Thanks,
>
> J.[/color]


This has just one problem in that you can only run it once and then you
have to restart Access before you can run it again (OK for weekly or
daily reports but not if you're exporting all day) due to some glitch
I've not been able to figure out yet.

It has all the formating bits in it you'll want and methods to use to
write Spreadhseets any way you want. it includes writing headers and
footers, set Window Zoom, settin gridlines and Row/Column headings on &
off formating cells and even adding comments to cells.

Hope this helps

Option Compare Database
Option Explicit


Function ExportTravelReport(strDestination As String) As Boolean
'On Error GoTo eh_ExportTravelReport

Dim dbLocal As Database
Dim rstTravel As Recordset
Dim intCurrTask As Integer
Dim wbknew As Excel.Workbook, wksnew As Excel.Worksheet
Dim appExcel As New Excel.Application
Dim strRange As String
Dim strCurrChannel As String
Dim strRecipients As String
Dim introw As Integer
Dim intStartRow As Integer

ExportTravelReport = True

'open data table
Set dbLocal = CurrentDb()
Set rstTravel = dbLocal.OpenRecordset("qry_Travel_Report_Output",
dbOpenSnapshot)

'set up Workbook
Set wbknew = appExcel.Workbooks.Add
Set wksnew = wbknew.Worksheets.Add
appExcel.Visible = True

'write Legend
wksnew.Cells(1, 7) = "Y = Qantas full economy"
wksnew.Cells(2, 7) = "B = Qantas 5 day advance purchase economy"
wksnew.Cells(3, 7) = "V = Qantas 14 day advance purchase economy"
wksnew.Cells(4, 7) = "H = Qantas 21 day advance purchase economy"
wksnew.Cells(5, 7) = "P = Qantas First Class"
wksnew.Cells(1, 10) = "M = Special domestic"
wksnew.Cells(2, 10) = "J = Business Class"
wksnew.Cells(3, 10) = "D = Discount Business Class"
wksnew.Cells(4, 10) = "F = First Class other"

Call SetColumnWidths
Call WriteComments

rstTravel.MoveFirst
introw = 5
Do While Not rstTravel.EOF

strCurrChannel = Nz(rstTravel!ChannelName, "unknown")
introw = WriteHeader(strCurrChannel, introw, wksnew)
intStartRow = introw

Do While rstTravel!ChannelName = strCurrChannel

'write record
wksnew.Cells(introw, 1) = rstTravel!BSB
wksnew.Cells(introw, 2) = rstTravel!CC
wksnew.Cells(introw, 3) = rstTravel!Type
wksnew.Cells(introw, 4) = rstTravel!Reference
wksnew.Cells(introw, 5) = rstTravel!Passenger
wksnew.Cells(introw, 6) = rstTravel!Value
wksnew.Cells(introw, 7) = rstTravel!CouponRouting
wksnew.Cells(introw, 8) = rstTravel!ClassUsed
wksnew.Cells(introw, 9) = rstTravel!AirlineUsed
wksnew.Cells(introw, 10) = CStr(Format(rstTravel!DDate,
"dd/mmm/yyyy"))

wksnew.Range(Cells(introw, 1), Cells(introw, 10)).Select
Call SetFont(False, False, 8)
Call SetInteriorBorder
Call SetEdgeLeftBorder
Call SetEdgeRightBorder
Call SetEdgeTopBorder
Call SetEdgeBottomBorder
wksnew.Cells(introw, 6).Select
Selection.NumberFormat = "$##,##0"
wksnew.Cells(introw, 10).Select
introw = introw + 1
rstTravel.MoveNext

If rstTravel.EOF Then Exit Do

Loop

Call WriteFooter(introw, wksnew, intStartRow)
introw = introw + 1

Loop

With ActiveWindow
.Zoom = 100
.DisplayGridlines = False
.DisplayHeadings = False
End With
wksnew.Range("G1:J5").Select
Selection.HorizontalAlignment = xlLeft
Call SetFont(True, False, 6)

If Dir(strDestination) = Right(strDestination, 22) Then
Kill strDestination
End If

Set wbknew = Nothing
Set wksnew = Nothing

ActiveWorkbook.SaveAs Filename:=strDestination, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, CreateBackup:=False

If MsgBox("Do you want to sent this Travel Report now", vbYesNo,
"Send?") = vbYes Then

If appExcel.MailSystem <> xlNoMailSystem Then

strRecipients = InputBox("Enter the Email address for the
person receiving this Travel Report.", "Enter Recipient.")

If Not IsNull(Nz(strRecipients)) Then

appExcel.Dialogs(xlDialogSendMail).Show
arg1:=strRecipients, Arg2:="Travel Report for the month of " &
Forms!frm_Enter_Travel_Reports!cbo_Exp_Month

End If

Else

MsgBox "No Email system is available on this PC", , "No Email."

End If

End If

ActiveWorkbook.Close
appExcel.Quit
Set appExcel = Nothing

rstTravel.Close
dbLocal.Close

Exit Function

eh_ExportTravelReport:
ExportTravelReport = False
End Function

Sub SetFont(booBold As Boolean, booItal As Boolean, intSize As Integer,
Optional strFont As String)

With Selection.Font
.Bold = booBold
.Italic = booItal
.Name = IIf(IsMissing(strFont), "Arial", strFont)
.Size = intSize
End With

End Sub

Sub SetInteriorBorder()
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub

Sub SetEdgeLeftBorder()
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub

Sub SetEdgeRightBorder()
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub

Sub SetEdgeTopBorder()
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub

Sub SetEdgeBottomBorder()
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub

Function WriteHeader(strChannel As String, introw As Integer, wksnew As
Worksheet) As Integer

'creates the header for each Channel
wksnew.Cells(introw, 1) = strChannel
wksnew.Cells(introw, 1).Select
Call SetFont(True, True, 10)
wksnew.Cells(introw, 1).Select
Selection.HorizontalAlignment = xlLeft

introw = introw + 1

'enter headings
wksnew.Cells(introw, 1) = "BSB"
wksnew.Cells(introw, 2) = "CC"
wksnew.Cells(introw, 3) = "Type"
wksnew.Cells(introw, 4) = "Invoice Reference"
wksnew.Cells(introw, 5) = "Passenger"
wksnew.Cells(introw, 6) = "Owing Value"
wksnew.Cells(introw, 7) = "Coupon Routing"
wksnew.Cells(introw, 8) = "Class Used"
wksnew.Cells(introw, 9) = "Airline Used"
wksnew.Cells(introw, 10) = "Depature Date"

'format headings
wksnew.Range(Cells(introw, 1), Cells(introw, 10)).Select
Call SetFont(True, False, 10)
Call SetEdgeLeftBorder
Call SetEdgeRightBorder
Call SetEdgeTopBorder
Call SetEdgeBottomBorder

WriteHeader = introw + 1

End Function


Sub WriteFooter(introw As Integer, wksnew As Worksheet, intStartRow As
Integer)

'writes and formats the subtotals for each Channel
introw = introw + 1
wksnew.Cells(introw, 5) = "Sub Total"
wksnew.Cells(introw, 5).Select
Call SetFont(True, False, 10)
wksnew.Cells(introw, 6).Value = "=Sum(F" & intStartRow & ":F" &
introw - 2 & ")"
wksnew.Cells(introw, 5).Select
Call SetFont(True, False, 10)
Selection.NumberFormat = "$##,##0"

End Sub


Sub SetColumnWidths()

Columns("A:A").ColumnWidth = 7.57
Columns("B:B").ColumnWidth = 4.29
Columns("C:C").ColumnWidth = 7.43
Columns("D:D").ColumnWidth = 18
Columns("E:E").ColumnWidth = 26.86
Columns("F:F").ColumnWidth = 12.71
Columns("G:G").ColumnWidth = 19.57
Columns("H:H").ColumnWidth = 10.86
Columns("I:I").ColumnWidth = 11.14
Columns("J:J").ColumnWidth = 18.57
Columns("A:J").Select
Selection.HorizontalAlignment = xlCenter

End Sub

Sub WriteComments()

Range("G6").Select
Range("G6").AddComment
Range("G6").Comment.Visible = False
Range("G6").Comment.Text Text:= _
"MEL = Melbourne" & Chr(10) & "SYD = Sydney" & Chr(10) & "CBR =
Canberra" & Chr(10) & "ADL = Adelaide"

Range("H6").Select
Range("H6").AddComment
Range("H6").Comment.Visible = False
Range("H6").Comment.Text Text:= _
"Y = Qantas full economy" & Chr(10) & "B = Qantas 5 day advance" &
Chr(10) & "V = Qantas 14 Day"
Range("H6").Comment.Shape.Height = 50
Range("H6").Comment.Shape.Width = 150

Range("I6").Select
Range("I6").AddComment
Range("I6").Comment.Visible = False
Range("I6").Comment.Text Text:= _
"QF = Qantas Airways" & Chr(10) & "UA = United Airlines" & Chr(10)
& "CO = Continental Airlines" & Chr(10) & "BA = British Airways"
Range("I6").Comment.Shape.Height = 50
Range("I6").Comment.Shape.Width = 150
End Sub
Daniel
Guest
 
Posts: n/a
#4: Nov 13 '05

re: Export Data to Excel


I am having a similar problem. I have HUGE database, millions of
records, I need a large sum of them in Excel. Because one spreadsheet
in excel can only hold 65,536 rows of data I am forced to use multiple
spreadsheets. I have written a macro in access to select which ever
65,536 rows of data in need. I thought that would be the hard part...I
was wrong. Now I need this macro (in access) to copy the selected
rows, then I could use a macro in excel to paste them. If you could
help me past this problem, I will try my best to help you.
Larry Daugherty
Guest
 
Posts: n/a
#5: Nov 13 '05

re: Export Data to Excel


Hi,

Your programming problem is in the Excel universe. I'd post in relevant
Excel newsgroups so solve the problem you posted. Once you can do it in
Excel using VBA you can then copy the code into Access VBA and continue it
until you have the functionality you want.

Microsoft.public.excel.programming etc.

HTH
--
-Larry-
--

"PC Datasheet" <nospam@nospam.spam> wrote in message
news:P8DBc.8849$bs4.8789@newsread3.news.atl.earthl ink.net...[color=blue]
> Export your data into a standard worksheet and in your pre-designed excel
> worksheet use formulas to get the data from that worksheet.
>
> --
> PC Datasheet
> Your Resource For Help With Access, Excel And Word Applications
> resource@pcdatasheet.com
> www.pcdatasheet.com
>
>
> "Jonny" <jonnymenthol@yahoo.com> wrote in message
> news:14f4e726.0406210652.1dfb7ead@posting.google.c om...[color=green]
> > Hello,
> >
> > I have created a button on my form which when pressed does the
> > following :
> >
> > 1) Run a pre-defined Macro, which is picking up a query and running my
> > data to excel.
> >
> > However, I need the data to export into Excel in a certain format, i.e
> > it needs to begin importing at cell A4, and in truth it would be great
> > if I could get the data to populate a pre-designed excel worksheet.
> >
> > would anyone be able to help me do this please ?
> >
> > Thanks,
> >
> > J.[/color]
>
>[/color]


Jonny
Guest
 
Posts: n/a
#6: Nov 13 '05

re: Export Data to Excel


"Mr. Smith" <Mr.Smith@Large> wrote in message news:<40d78685$0$29881$61ce578d@news.syd.swiftdsl. com.au>...[color=blue]
> Jonny wrote:
>[color=green]
> > Hello,
> >
> > I have created a button on my form which when pressed does the
> > following :
> >
> > 1) Run a pre-defined Macro, which is picking up a query and running my
> > data to excel.
> >
> > However, I need the data to export into Excel in a certain format, i.e
> > it needs to begin importing at cell A4, and in truth it would be great
> > if I could get the data to populate a pre-designed excel worksheet.
> >
> > would anyone be able to help me do this please ?
> >
> > Thanks,
> >
> > J.[/color]
>
>
> This has just one problem in that you can only run it once and then you
> have to restart Access before you can run it again (OK for weekly or
> daily reports but not if you're exporting all day) due to some glitch
> I've not been able to figure out yet.
>
> It has all the formating bits in it you'll want and methods to use to
> write Spreadhseets any way you want. it includes writing headers and
> footers, set Window Zoom, settin gridlines and Row/Column headings on &
> off formating cells and even adding comments to cells.
>
> Hope this helps
>
> Option Compare Database
> Option Explicit
>
>
> Function ExportTravelReport(strDestination As String) As Boolean
> 'On Error GoTo eh_ExportTravelReport
>
> Dim dbLocal As Database
> Dim rstTravel As Recordset
> Dim intCurrTask As Integer
> Dim wbknew As Excel.Workbook, wksnew As Excel.Worksheet
> Dim appExcel As New Excel.Application
> Dim strRange As String
> Dim strCurrChannel As String
> Dim strRecipients As String
> Dim introw As Integer
> Dim intStartRow As Integer
>
> ExportTravelReport = True
>
> 'open data table
> Set dbLocal = CurrentDb()
> Set rstTravel = dbLocal.OpenRecordset("qry_Travel_Report_Output",
> dbOpenSnapshot)
>
> 'set up Workbook
> Set wbknew = appExcel.Workbooks.Add
> Set wksnew = wbknew.Worksheets.Add
> appExcel.Visible = True
>
> 'write Legend
> wksnew.Cells(1, 7) = "Y = Qantas full economy"
> wksnew.Cells(2, 7) = "B = Qantas 5 day advance purchase economy"
> wksnew.Cells(3, 7) = "V = Qantas 14 day advance purchase economy"
> wksnew.Cells(4, 7) = "H = Qantas 21 day advance purchase economy"
> wksnew.Cells(5, 7) = "P = Qantas First Class"
> wksnew.Cells(1, 10) = "M = Special domestic"
> wksnew.Cells(2, 10) = "J = Business Class"
> wksnew.Cells(3, 10) = "D = Discount Business Class"
> wksnew.Cells(4, 10) = "F = First Class other"
>
> Call SetColumnWidths
> Call WriteComments
>
> rstTravel.MoveFirst
> introw = 5
> Do While Not rstTravel.EOF
>
> strCurrChannel = Nz(rstTravel!ChannelName, "unknown")
> introw = WriteHeader(strCurrChannel, introw, wksnew)
> intStartRow = introw
>
> Do While rstTravel!ChannelName = strCurrChannel
>
> 'write record
> wksnew.Cells(introw, 1) = rstTravel!BSB
> wksnew.Cells(introw, 2) = rstTravel!CC
> wksnew.Cells(introw, 3) = rstTravel!Type
> wksnew.Cells(introw, 4) = rstTravel!Reference
> wksnew.Cells(introw, 5) = rstTravel!Passenger
> wksnew.Cells(introw, 6) = rstTravel!Value
> wksnew.Cells(introw, 7) = rstTravel!CouponRouting
> wksnew.Cells(introw, 8) = rstTravel!ClassUsed
> wksnew.Cells(introw, 9) = rstTravel!AirlineUsed
> wksnew.Cells(introw, 10) = CStr(Format(rstTravel!DDate,
> "dd/mmm/yyyy"))
>
> wksnew.Range(Cells(introw, 1), Cells(introw, 10)).Select
> Call SetFont(False, False, 8)
> Call SetInteriorBorder
> Call SetEdgeLeftBorder
> Call SetEdgeRightBorder
> Call SetEdgeTopBorder
> Call SetEdgeBottomBorder
> wksnew.Cells(introw, 6).Select
> Selection.NumberFormat = "$##,##0"
> wksnew.Cells(introw, 10).Select
> introw = introw + 1
> rstTravel.MoveNext
>
> If rstTravel.EOF Then Exit Do
>
> Loop
>
> Call WriteFooter(introw, wksnew, intStartRow)
> introw = introw + 1
>
> Loop
>
> With ActiveWindow
> .Zoom = 100
> .DisplayGridlines = False
> .DisplayHeadings = False
> End With
> wksnew.Range("G1:J5").Select
> Selection.HorizontalAlignment = xlLeft
> Call SetFont(True, False, 6)
>
> If Dir(strDestination) = Right(strDestination, 22) Then
> Kill strDestination
> End If
>
> Set wbknew = Nothing
> Set wksnew = Nothing
>
> ActiveWorkbook.SaveAs Filename:=strDestination, _
> FileFormat:=xlNormal, Password:="", WriteResPassword:="",
> ReadOnlyRecommended:=False, CreateBackup:=False
>
> If MsgBox("Do you want to sent this Travel Report now", vbYesNo,
> "Send?") = vbYes Then
>
> If appExcel.MailSystem <> xlNoMailSystem Then
>
> strRecipients = InputBox("Enter the Email address for the
> person receiving this Travel Report.", "Enter Recipient.")
>
> If Not IsNull(Nz(strRecipients)) Then
>
> appExcel.Dialogs(xlDialogSendMail).Show
> arg1:=strRecipients, Arg2:="Travel Report for the month of " &
> Forms!frm_Enter_Travel_Reports!cbo_Exp_Month
>
> End If
>
> Else
>
> MsgBox "No Email system is available on this PC", , "No Email."
>
> End If
>
> End If
>
> ActiveWorkbook.Close
> appExcel.Quit
> Set appExcel = Nothing
>
> rstTravel.Close
> dbLocal.Close
>
> Exit Function
>
> eh_ExportTravelReport:
> ExportTravelReport = False
> End Function
>
> Sub SetFont(booBold As Boolean, booItal As Boolean, intSize As Integer,
> Optional strFont As String)
>
> With Selection.Font
> .Bold = booBold
> .Italic = booItal
> .Name = IIf(IsMissing(strFont), "Arial", strFont)
> .Size = intSize
> End With
>
> End Sub
>
> Sub SetInteriorBorder()
> With Selection.Borders(xlInsideVertical)
> .LineStyle = xlContinuous
> .Weight = xlThin
> .ColorIndex = xlAutomatic
> End With
> End Sub
>
> Sub SetEdgeLeftBorder()
> With Selection.Borders(xlEdgeLeft)
> .LineStyle = xlContinuous
> .Weight = xlThin
> .ColorIndex = xlAutomatic
> End With
> End Sub
>
> Sub SetEdgeRightBorder()
> With Selection.Borders(xlEdgeRight)
> .LineStyle = xlContinuous
> .Weight = xlThin
> .ColorIndex = xlAutomatic
> End With
> End Sub
>
> Sub SetEdgeTopBorder()
> With Selection.Borders(xlEdgeTop)
> .LineStyle = xlContinuous
> .Weight = xlThin
> .ColorIndex = xlAutomatic
> End With
> End Sub
>
> Sub SetEdgeBottomBorder()
> With Selection.Borders(xlEdgeBottom)
> .LineStyle = xlContinuous
> .Weight = xlThin
> .ColorIndex = xlAutomatic
> End With
> End Sub
>
> Function WriteHeader(strChannel As String, introw As Integer, wksnew As
> Worksheet) As Integer
>
> 'creates the header for each Channel
> wksnew.Cells(introw, 1) = strChannel
> wksnew.Cells(introw, 1).Select
> Call SetFont(True, True, 10)
> wksnew.Cells(introw, 1).Select
> Selection.HorizontalAlignment = xlLeft
>
> introw = introw + 1
>
> 'enter headings
> wksnew.Cells(introw, 1) = "BSB"
> wksnew.Cells(introw, 2) = "CC"
> wksnew.Cells(introw, 3) = "Type"
> wksnew.Cells(introw, 4) = "Invoice Reference"
> wksnew.Cells(introw, 5) = "Passenger"
> wksnew.Cells(introw, 6) = "Owing Value"
> wksnew.Cells(introw, 7) = "Coupon Routing"
> wksnew.Cells(introw, 8) = "Class Used"
> wksnew.Cells(introw, 9) = "Airline Used"
> wksnew.Cells(introw, 10) = "Depature Date"
>
> 'format headings
> wksnew.Range(Cells(introw, 1), Cells(introw, 10)).Select
> Call SetFont(True, False, 10)
> Call SetEdgeLeftBorder
> Call SetEdgeRightBorder
> Call SetEdgeTopBorder
> Call SetEdgeBottomBorder
>
> WriteHeader = introw + 1
>
> End Function
>
>
> Sub WriteFooter(introw As Integer, wksnew As Worksheet, intStartRow As
> Integer)
>
> 'writes and formats the subtotals for each Channel
> introw = introw + 1
> wksnew.Cells(introw, 5) = "Sub Total"
> wksnew.Cells(introw, 5).Select
> Call SetFont(True, False, 10)
> wksnew.Cells(introw, 6).Value = "=Sum(F" & intStartRow & ":F" &
> introw - 2 & ")"
> wksnew.Cells(introw, 5).Select
> Call SetFont(True, False, 10)
> Selection.NumberFormat = "$##,##0"
>
> End Sub
>
>
> Sub SetColumnWidths()
>
> Columns("A:A").ColumnWidth = 7.57
> Columns("B:B").ColumnWidth = 4.29
> Columns("C:C").ColumnWidth = 7.43
> Columns("D:D").ColumnWidth = 18
> Columns("E:E").ColumnWidth = 26.86
> Columns("F:F").ColumnWidth = 12.71
> Columns("G:G").ColumnWidth = 19.57
> Columns("H:H").ColumnWidth = 10.86
> Columns("I:I").ColumnWidth = 11.14
> Columns("J:J").ColumnWidth = 18.57
> Columns("A:J").Select
> Selection.HorizontalAlignment = xlCenter
>
> End Sub
>
> Sub WriteComments()
>
> Range("G6").Select
> Range("G6").AddComment
> Range("G6").Comment.Visible = False
> Range("G6").Comment.Text Text:= _
> "MEL = Melbourne" & Chr(10) & "SYD = Sydney" & Chr(10) & "CBR =
> Canberra" & Chr(10) & "ADL = Adelaide"
>
> Range("H6").Select
> Range("H6").AddComment
> Range("H6").Comment.Visible = False
> Range("H6").Comment.Text Text:= _
> "Y = Qantas full economy" & Chr(10) & "B = Qantas 5 day advance" &
> Chr(10) & "V = Qantas 14 Day"
> Range("H6").Comment.Shape.Height = 50
> Range("H6").Comment.Shape.Width = 150
>
> Range("I6").Select
> Range("I6").AddComment
> Range("I6").Comment.Visible = False
> Range("I6").Comment.Text Text:= _
> "QF = Qantas Airways" & Chr(10) & "UA = United Airlines" & Chr(10)
> & "CO = Continental Airlines" & Chr(10) & "BA = British Airways"
> Range("I6").Comment.Shape.Height = 50
> Range("I6").Comment.Shape.Width = 150
> End Sub[/color]


Thank you very much for this - I'll have a look at it.
Closed Thread