UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Power Maps - Automate Creation, Office 2013    
 
   
WildBird
post Dec 4 2019, 05:52 PM
Post#1


UtterAccess VIP
Posts: 3,676
Joined: 19-August 03
From: Auckland, Little Australia


Hi,

Wondering if anyone has done anything automating Power maps in Office 365? I can automate everything else, getting data into Excel sheet, pivot tables, slicers all sort of stuff, but I can work out how to automate the 3D Power Map part. Recording a macro doesnt show anything.

The sheet is recreated each time it is run, and all pivot tables etc are built, data sheets are populated etc, so I need to be able to build the map and layers etc via code if possible.

Any insights, I am grateful for!

Cheers

--------------------
Beer, natures brain defragging tool.
Go to the top of the page
 
Debaser
post Dec 5 2019, 07:01 AM
Post#2



Posts: 156
Joined: 11-October 18



Can you not use a template with all the pivots and maps already established, and then just update the data? It's usually a lot simpler, if it's an option.
Go to the top of the page
 
WildBird
post Dec 5 2019, 05:56 PM
Post#3


UtterAccess VIP
Posts: 3,676
Joined: 19-August 03
From: Auckland, Little Australia


Hi,

The way the files are used, they are 'self contained', i.e. all the data is embedded in them, no data connections to external places. All the pivots are built dynamically before the file is opened, and they each have a button that will rebuild them. Users can go to the data sheet for each pivot and add new columns, then go back to the sheet, and rebuild everything and the new column(s) will be available. The pivot tables work fine, it is the map part that I cant work out.

What I am doing now is building a connection to the data in the datasheet. Users then have to go to the 3D Map part manually, but they can now do it without going to the datasheet first (I hide all data sheets via code - pivot sheet have hyperlinks to their corresponding data sheets that unhide them).

I have no idea how this mapping part can be automated.......

CODE
Function AddMapConnection() As Boolean
'Date:          Friday, 06 December 2019 9:24:48 AM
'Author:        Stephen Cooper
'Email:         cooper@XXXXXXXXXXXXXXXXXX
'Ph:
'In parameters
'Output
'Description:
'Calls:
'Notes:
'Example:

On Error GoTo HandleError:

AddMapConnection = True

Dim intMouseType As Integer
Dim strErrorMsg As String
Dim varReturn As Variant
Dim strDataSheet As String
Dim strSourceAddress As String

intMouseType = Application.Cursor

Application.Cursor = xlWait

strDataSheet = "GroupedGenderAgeData"

strSourceAddress = GetSourceAddress(strDataSheet)

Workbooks(ThisWorkbook.Name).Connections.Add2 "WorksheetConnection_" & strDataSheet & "!$A$1:" & strSourceAddress, "", "WORKSHEET;" & CheckPath(ThisWorkbook.Path) & "[" & ThisWorkbook.Name & "]", strDataSheet & "!$A$1:" & strSourceAddress, 7, True, False

ExitHere:
On Error Resume Next
'Close all recordsets etc here
'varReturn = SysCmd(acSysCmdClearStatus)
Application.Cursor = intMouseType
Exit Function

HandleError:
Select Case Err.Number
Case Else
    LogError "AddMapConnection|" & ThisWorkbook.Name & "|" & strErrorMsg & "|" & Err.Number & " - " & Err.Description & "| Line number " & Erl
    MsgBox strErrorMsg & " " & Err.Number & " " & Err.Description, vbInformation, "Error"
    AddMapConnection = False
    'DoCmd.Close acForm, strUpdateForm, acSaveNo
    Resume ExitHere
End Select

End Function


Function GetSourceAddress(ByVal strSheetName As String) As String
'Date:          Wednesday, 18 February 2009 10:02:05 AM
'Author:        Stephen Cooper
'Email:         stephen.cooper@XXXXXXXXXXXXXXXX
'Ph:            23561
'In parameters
'Output
'Description:   Will return the address
'Calls:
'Notes:
'Example:

On Error GoTo HandleError:

GetSourceAddress = True

Dim intMouseType As Integer
Dim strErrorMsg As String
Dim varReturn As Variant
Dim lLastRow As Long
Dim lLastCol As Long
Dim i As Integer
Dim wks As Worksheet

'Need to make sure page is visible
Worksheets(strSheetName).Visible = xlSheetVisible

i = 1

Set wks = Sheets(strSheetName)

wks.Select
'Now that the data sheet has been selected, can get the special cells ie the end cells
lLastRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row
'lLastCol = ActiveSheet.Cells.SpecialCells(xlLastCell).Column
While Len(Trim(wks.Cells(1, i))) > 0
    i = i + 1
Wend

If i = 1 Then
    lLastCol = i
Else
    lLastCol = i - 1
End If 'i = 1

GetSourceAddress = Cells(lLastRow, lLastCol).Address

ExitHere:
On Error Resume Next
'Close all recordsets etc here
Worksheets(strSheetName).Visible = xlSheetHidden
Exit Function

HandleError:
Select Case Err.Number
Case Else
    MsgBox strErrorMsg & " " & Err.Number & " " & Err.Description, vbInformation, "Error"
    GetSourceAddress = False
Resume ExitHere
End Select

End Function

--------------------
Beer, natures brain defragging tool.
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    11th December 2019 - 08:30 AM