Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.databases.ms-access > #9649

Re: Access creating page headers upon exporting to Excel?

From "Phil" <phil@stantonfamily.co.uk>
Newsgroups comp.databases.ms-access
Subject Re: Access creating page headers upon exporting to Excel?
Date 2014-07-08 17:37 +0100
Organization Aioe.org NNTP Server
Message-ID <lph6nd$3hd$1@speranza.aioe.org> (permalink)
References <3b9a6ece-468b-4d36-9acc-23eac250ef5f@googlegroups.com> <841364cc-bc15-4481-a748-416c3905476c@googlegroups.com>

Show all headers | View raw

On 08/07/2014 15:01:17, Tim wrote:
> Here is an example of what I mean by the header. I want to use all three
> boxes across
> 
> http://blog.softartisans.com/wp-content/uploads/2012/05/page_header_footer_ow_header_edited.png
> 

I don't know if this is of any help and it was written in Access 2000, so
things have moved on.

This is a bit of code to create some information in Excel and format the
cells.

The details are irrelevant and this is hust a random bit of code, but it
might help.

An approach that I found very helpful was to record a Macro in Excel, then
use it in Access

Phil

Header:
    ' Show Microsoft Excel through its Application property. Then
    ' show the actual window containing the file using the Windows
    ' collection of the MyXL object reference.
    MyXL.Parent.Windows(1).Visible = True
    
    Select Case Frm!ResultTypeIDRelay

Case 1                                              ' Combined
SheetName Name = TabName(Path, FileName, Frm!SeriesID, 1) & " " &
Frm!ResultTypeIDRelay.Column(0)

Case 2                                              ' Division
SheetName Name = TabName(Path, FileName, Frm!SeriesID, 1) & " " &
StartSet!Division

Case 4
SheetName Name = TabName(Path, FileName, Frm!SeriesID, 1) & " " &
StartSet!BoatClass

Case Else
    MsgBox "Not yet written", vbCritical
    GoTo AllDone
    
End Select
    
NameSheet:
    With MyXL.Application
        If .Worksheets(i).Name <> SheetName Then        ' Name changed
            .Worksheets(i).Name = SheetName
        End If
        .Worksheets(i).Activate
        .Range("A1:Q100").Clear
        .Range("A1:Q100").Font.Size = FontSize10_9
        .Range("A1:Q100").Font.Bold = False
        '.Range("A1:Q6").Font.Name = "Arial"
        '.Range("A7:Q100").Font.Name = "Arial Narrow"    ' To make more room
        .Range("A1:Q100").Font.Name = "Arial"
Range("H7:Q100").Font.Name ont.Name = "Arial Narrow" ' Race Results To make
more room

        .Cells(1, 1).Font.Size = FontSize14_12
        .Cells(1, 1).Font.Color = 255
        .Cells(1, 1).Font.Bold = True
        .Cells(1, 1).Value = "Overall Results " & Frm!SeriesName
    End With
    
    ActiveSheet.Range("I1").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        "http://www.pofr.freeuk.com/results.htm", TextToDisplay:="Back"
           
    With MyXL.Application
        .Columns("A").ColumnWidth = 7                       ' Position
        .Range("A9:A100").Font.Bold = True
        .Columns("B").ColumnWidth = 20                      ' Boat name
        .Columns("C").ColumnWidth = ColumnWidth10_9         ' Sail No
        If Frm!ResultTypeIDRelay = 1 Then                   ' Combined
            .Columns("D").ColumnWidth = ColumnWidth10_9     ' Division
            .Columns("D").HorizontalAlignment = xlRight     ' Right
        ElseIf Frm!ResultTypeIDRelay = 2 Then               ' Division
            .Columns("D").ColumnWidth = 0                   ' Division
        ElseIf Frm!ResultTypeIDRelay = 4 Then               ' Boat Class
            .Columns("D").ColumnWidth = ColumnWidth10_9     ' Division
            .Columns("D").HorizontalAlignment = xlRight     ' Right
        End If
        .Columns("E").ColumnWidth = 6       ' Club
        .Columns("F").ColumnWidth = 6       ' Total Points
        .Columns("G").ColumnWidth = 6       ' Total Ex Discards
        .Columns("G").Font.Bold = True      ' Total Ex Discards
        .Columns("H").ColumnWidth = ColumnWidths8Quart_7Quart      ' Races
        .Columns("I").ColumnWidth = ColumnWidths8Quart_7Quart
        .Columns("J").ColumnWidth = ColumnWidths8Quart_7Quart
        .Columns("K").ColumnWidth = ColumnWidths8Quart_7Quart
        .Columns("L").ColumnWidth = ColumnWidths8Quart_7Quart
        .Columns("M").ColumnWidth = ColumnWidths8Quart_7Quart
        .Columns("N").ColumnWidth = ColumnWidths8Quart_7Quart
        .Columns("O").ColumnWidth = ColumnWidths8Quart_7Quart
        .Columns("P").ColumnWidth = ColumnWidths8Quart_7Quart
        .Columns("Q").ColumnWidth = ColumnWidths8Quart_7Quart
        .Range("F7:G8").HorizontalAlignment = xlRight               ' right
        .Range("H7:Q100").HorizontalAlignment = xlCenter            ' center
        .Range("H7:Q100").Font.Color = 16711680                     ' blue
        .Cells(2, 1).Font.Size = FontSize14_12
        .Cells(2, 1).Font.Color = 255
        .Cells(2, 1).Font.Bold = True
        If Frm!ResultTypeIDRelay = 1 Then               ' Combined
            .Cells(2, 1).Value = Frm!ResultTypeIDRelay.Column(0)
            .Cells(2, 5).Value = GetTrophyName("", 1)
            .Cells(2, 5).Font.Size = FontSize14_12
            .Cells(2, 5).Font.Color = 255
            .Cells(2, 5).Font.Bold = True
        ElseIf Frm!ResultTypeIDRelay = 2 Then           ' Division
            .Cells(2, 1).Value = "Division: " & StartSet!Division
            .Cells(2, 5).Value = GetTrophyName(StartSet!Division, 2)
            .Cells(2, 5).Font.Size = FontSize14_12
            .Cells(2, 5).Font.Color = 255
            .Cells(2, 5).Font.Bold = True
        ElseIf Frm!ResultTypeIDRelay = 4 Then           ' Boat Class
            .Cells(2, 1).Value = "Boat Class: " & StartSet!BoatClass
        End If
        
Cells(4, Cells(4, 1).Value = Frm!RacesCompleted & " races sailed, " &
Frm!RacesCounting & " to count. Discards shown in (brackets)"

Titles:
        .Range("A7:Z8").Font.Size = FontSize11_10
        .Range("A7:Z8").Font.Bold = True
        .Cells(7, 1).Value = "Position"
        .Cells(7, 2).Value = "Boat Name"
        .Cells(7, 3).Value = "Sail No"
        If Frm!ResultTypeIDRelay = 1 Then        ' Combimed
            .Cells(7, 4).Value = "Division"
        End If
        If Frm!ResultTypeIDRelay = 4 Then        ' Boat Class
            .Cells(7, 4).Value = "Division"
        End If
        .Cells(7, 5).Value = "Club"
        .Cells(7, 6).Value = "Gross"
        .Cells(7, 7).Value = "Nett"
        .Cells(8, 6).Value = "Points"
        .Cells(8, 7).Value = "Points"
         
    ' Find common words in the race descriptions
    FirstSpacePos = 1
    HoldWord = ""
    TestWord = ""
FirstRaceStart:
Name Name = Frm!SeriesName & " " ' Add a space to get complete series name
    NextSpacePos = InStr(FirstSpacePos, Name, " ")
    If NextSpacePos = 0 Then GoTo RaceTitles
    If HoldWord = "" Then
        HoldWord = Mid(Name, FirstSpacePos, NextSpacePos - FirstSpacePos)
    Else
HoldWord HoldWord = HoldWord & " " & Mid(Name, FirstSpacePos, NextSpacePos -
FirstSpacePos)     End If
    k = 8
    
NextRaceStart:
    k = k + 1
' ' ResultsSet.Fields(i).Name has the form "POFR 2002 race 1 <CR> 01/06/02"
    If k = ResultsSet.Fields.Count - 1 Then
        FirstSpacePos = NextSpacePos + 1
        TestWord = HoldWord
        GoTo FirstRaceStart
    End If
    Name = ResultsSet.Fields(k).Name
      
    NextSpacePos = InStr(FirstSpacePos, Name, " ")
    If TestWord = "" Then
        Word = Mid(Name, FirstSpacePos, NextSpacePos - FirstSpacePos)
    Else
Word Word = TestWord & " " & Mid(Name, FirstSpacePos, NextSpacePos -
FirstSpacePos)     End If
    If Word = HoldWord Then
        GoTo NextRaceStart
    End If
    
RaceTitles:
    For k = 9 To ResultsSet.Fields.Count - 1
Cells(7, Cells(7, k - 1).Value = CleanRace(ResultsSet.Fields(k).Name,
HoldWord, 1) .Cells(8, k - 1).Value = CleanRace(ResultsSet.Fields(k).Name,
HoldWord, 2)     Next
    End With
    
    With ResultsSet
        j = 0
NextBoat:
        If .EOF Then
            GoTo AllDone
        End If
        If Frm!ResultTypeIDRelay = 2 Then          ' Division
            If !Division <> HoldDivision Then
                HoldDivision = !Division
                StartSet.MoveNext
                i = i + 1
                GoTo NextStart
            End If
        End If
        
        If Frm!ResultTypeIDRelay = 4 Then          ' Boat Class
            If !BoatClass <> HoldDivision Then
                HoldDivision = !BoatClass
                StartSet.MoveNext
                i = i + 1
                GoTo NextStart
            End If
        End If
        j = j + 1
        If j = 1 Then
            MyXL.Application.Range("A9:G9").Font.Bold = True
            MyXL.Application.Range("A9:G9").Font.Color = 255       'Red
        End If
        MyXL.Application.Cells(j + 8, 1).Value = !SeriesPosition
        MyXL.Application.Cells(j + 8, 2).Value = UCase(!BoatName)
        MyXL.Application.Cells(j + 8, 3).Value = !RacingNo
        If Frm!ResultTypeIDRelay = 1 Then

---
This email is free from viruses and malware because avast! Antivirus protection is active.
http://www.avast.com

Back to comp.databases.ms-access | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread

Thread

Access creating page headers upon exporting to Excel? Tim <tstubbs40@gmail.com> - 2014-07-08 06:46 -0700
  Re: Access creating page headers upon exporting to Excel? Tim <tstubbs40@gmail.com> - 2014-07-08 07:01 -0700
    Re: Access creating page headers upon exporting to Excel? "Phil" <phil@stantonfamily.co.uk> - 2014-07-08 17:37 +0100
    Re: Access creating page headers upon exporting to Excel? Sky <Sky@NoSpam.com> - 2014-07-08 13:19 -0400
      Re: Access creating page headers upon exporting to Excel? "Stuart McCall" <smccall@myunrealbox.com> - 2014-07-08 23:13 +0100

csiph-web