Results 1 to 3 of 3
  1. #1
    mindbender is offline Competent Performer
    Windows XP Access 2007
    Join Date
    May 2013
    Posts
    283

    VBA to rename tabs in multiple worksheets

    I have an event on a button that runs the following VBA

    Private Sub Command1_Click()
    On Error GoTo Err_Command1_Click
    Dim stDocName As String
    stDocName = "Create Coverage Map"
    DoCmd.RunMacro stDocName
    Exit_Command1_Click:
    Exit Sub
    Err_Command1_Click:
    MsgBox Err.Description
    Resume Exit_Command1_Click

    End Sub


    What it does is call a macro that creates 3 separate worksheets from queries and exports them.

    What I would like to do is rename the tab in each of the spreadsheets to a name and the current month. I was able to rename the entire workbook by using this
    Name "C:\Coverage Map.xls" As "c:\Coverage_Map_" + Format(Now, "YYYY-MM") + ".xls"
    Name "C:\Coverage Map Supplies.xls" As "c:\Coverage Map Supplies_" + Format(Now, "YYYY-MM") + ".xls"
    Name "C:\Coverage Map#2.xls" As "c:\Coverage Map#2_" + Format(Now, "YYYY-MM") + ".xls"

    but I would like to rename the tabs with the current month as well



    Any ideas?

  2. #2
    aytee111 is offline Competent At Times
    Windows 7 32bit Access 2010 32bit
    Join Date
    Nov 2011
    Location
    Nomad
    Posts
    3,936
    Worksheets carry the name of the query - so you will need to make a copy of your query prior to exporting.

    1 - create the original/main query
    2 - delete query named "worksheet/date"
    3 - copy original query to "worksheet/date"
    4 - export "worksheet/date"
    5 - delete query "worksheet/date"

  3. #3
    trevor40's Avatar
    trevor40 is offline Advanced db Manager
    Windows XP Access 2003
    Join Date
    Feb 2014
    Location
    Australia
    Posts
    402
    here ya go, create multiple sheets and name them as you go, with the range option for transferspreadsheet.

    Code:
    Private Sub Command94_Click()
        Dim db As DAO.Database
        Dim rs As DAO.Recordset
        Dim gg As String
        sdt = Format(start_date, "dd-mm-yy")
        edt = Format(End_date, "dd-mm-yy")
        gg = "C:\aaa\timesheets\Employee Time Report master.xls"
        aa = MsgBox("                 Do you also require Manaul Sheets ?", vbYesNoCancel + vbDefaultButton2, "Time Sheet Additions")
        If aa = vbYes Then
            CC = InputBox("Enter number of sheets required", "Excel time sheet generation", 1)
            bb = InputBox("Enter number of lines per sheet required", "Manual Time Sheet creation", 1)
            Else
            If aa = vbCancel Then Exit Sub
        End If
        Set db = CurrentDb()
        Set rs = db.OpenRecordset("create excel time sheets for selected employees on main menu")
        With rs
            .MoveFirst
            Do While Not .EOF
                fn = rs.Fields("First Name")
                Ln = rs.Fields("Last Name")
                cd = rs.Fields("Code #")
                bc = rs.Fields("barcode")
                Me.barcode = bc
                DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "print time sheets for selected employees", gg, True, fn & " " & Ln & " " & cd
                DoEvents
                .MoveNext
            Loop
        End With
        If aa = vbYes Then
            DoCmd.RunSQL "DELETE * FROM manual_sheet"
            t = Forms![main menu].start_date
            For i = 1 To bb
                Set rstActual = db.OpenRecordset("manual_sheet", dbOpenDynaset)
                rstActual.AddNew
                rstActual!new_date = t
                rstActual.Update
                rstActual.Close
                t = t + 1
            Next i
            nRecords = DCount("*", "Employee Time Report Output with lunch for manual sheet")
            If nRecords = 0 Then
                MsgBox "No data for selected period, change report dates and try agian.", vbOKOnly, "Error"
                Exit Sub
            End If
            For i = 1 To CC
                DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Employee Time Report Output with lunch for manual sheet", gg, True, "FirstName" & i & " " & "LastName" & i
            Next i
        End If
        rs.Close
        Set rs = Nothing
        Set db = Nothing
        Call format_sheets_now
        t = MsgBox("All requested Excel Time Sheets have been created" & vbCrLf & "          And saved in the following directory" & vbCrLf & vbCrLf & "                   C:\aaa\timesheets", vbOKOnly, "Automated Time Sheet Generation")
    End Sub                '***********************************************************************************************************************************************
    Private Sub Command147_Click()          'create manual time sheet
        Dim db As DAO.Database
        Set db = CurrentDb
        Dim rstActual As DAO.Recordset
        Set rstActual = db.OpenRecordset("manual_sheet")
        gg = "C:\aaa\timesheets\Employee Time Report master.xls"
        bb = InputBox("Enter number of sheets required", "Excel time sheet generation", 1)
        aa = InputBox("Enter number of lines per sheet required", "Manual Time Sheet creation", 1)
        fn = "FirstName"
        Ln = "LastName"
        DoCmd.RunSQL "DELETE * FROM manual_sheet"
        t = Forms![main menu].start_date
        For i = 1 To aa
            Set rstActual = db.OpenRecordset("manual_sheet", dbOpenDynaset)
            rstActual.AddNew
            rstActual!new_date = t
            rstActual.Update
            rstActual.Close
            t = t + 1
        Next i
        For i = 1 To bb
            DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Employee Time Report Output with lunch for manual sheet", gg, True, "FirstName" & i & " " & "LastName" & i
        Next i
        Call format_sheets_now
        t = MsgBox("All requested Excel Time Sheets have been created" & vbCrLf & "          And saved in the following directory" & vbCrLf & vbCrLf & "                   C:\aaa\timesheets", vbOKOnly, "Automated Time Sheet Generation")
    End Sub
    

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 9
    Last Post: 10-31-2013, 06:51 AM
  2. Replies: 28
    Last Post: 05-10-2013, 11:59 AM
  3. Replies: 3
    Last Post: 04-28-2013, 01:23 PM
  4. Replies: 0
    Last Post: 11-04-2011, 06:09 AM
  5. Replies: 3
    Last Post: 11-02-2009, 04:33 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums