HELP!! Hello, I've a map in powerpoint 2019, each division of the map is a shape, and I've to change the fill color of each one of thoseAttachment 26545 shapes according to a query from an Access database, I'm new in VBA with some knowlege of VB, there are only 125 shapes. any ideas? I'm attaching the pptx file with the map.
thasnk alot for the help
Can you post the Access table as well?
Hello XLD, thanks for your reply, I'm posting the access database, it has a table named catmun with 3 fields:
cvemun=key from 1 to 125, referencing to a municipality in the map
covid19_range= only 3 values: A, B and C depending on this value the corresponding shape has to fill with a selected color, the value in this field will be dynamyc.
Shape: the name of the shape that has to be filled with a selected color on the powerpoint's map according to the covid19_range value.
Thanks again for the help.Attachment 26560
Here you are my friend, you will need to set the database path variable to your file. I have just used the colours red, green and blue. Again, set the RGB values to your preference.
I assume that map is part of Mexico, whereabouts? I was due to be holidaying in Mexico on 14th of this month, near Leon, but that has been knocked on the head.
Code:Const DB_PATH As String = "C:\Users\Bob\Documents\Projects\_8 Community\Forums\VBAExpress\VBAX 67286 - Changing Shapes Colour in Powerpoint\covid19.accdb"
Public Function SetColours()
Dim data As Variant
Dim shapecolour As Variant
Dim i As Long
data = GetData
With ActivePresentation.Slides(1)
For i = LBound(data, 2) To UBound(data, 2)
Select Case data(1, i)
Case "A": shapecolour = RGB(255, 0, 0)
Case "B": shapecolour = RGB(0, 255, 0)
Case "C": shapecolour = RGB(0, 0, 255)
End Select
.Shapes(data(2, i)).Fill.ForeColor.RGB = shapecolour
Next i
End With
End Function
Private Function GetData() As Variant
Dim conn As Object
Dim RS As Object
Dim intColIndex As Integer
Dim DBFullName As String
Set conn = CreateObject("ADODB.Connection")
With conn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open DB_PATH
End With
Set RS = CreateObject("ADODB.Recordset")
RS.Open "SELECT * FROM [catmun]", conn, , , 1 'adCmdText
GetData = RS.GetRows
RS.Close: Set RS = Nothing
conn.Close: Set conn = Nothing
End Function
BTW, I would rename all of the actual map shapes to the municipality number, something like "Mun 123". You could write a macro to do it as you have the current shape num and the municipality number in your database. It would have the advantage of differentiating the actual map segments from the lines, as the latter would remain as Freeform xxx.
XLD!!!! thanks!!! Thanks!! it worked!!! :rofl: thank you so much!. Sure IŽll rename the object names on the map.
sorry to ear about your canceled planes to visit mexico :( as all people in the world says "stay at home". I'm working from home.
again thanks for the code!
XLD, I have an other issue, hope you can help, I change in the code the table named "catmun" for a query named "Total_x_mun_desc" because the data must be dynamic, but when I run the code only the first 27 records are loaded in memory, tried to change the query in a different way but the error still persists, so I decided to export the query to a table with the name "Total_x_mun_desc1" and all the records are loaded with no problem, because of this I've 2 choices:
1. create an update query for the table Total_x_mun_desc1 be updated with the data on the query Total_x_mun_desc, but how I do that, I mean, I know how to create the update query, but what I dont know is how to create the code for ejecute that update query before the code read the data in the table.
2. resolve the error, why only the first 27 records are loaded in mery, but I've no idea how.
thanks.
My guess would be that there is a null value that is causing the problem. Can you post the new database and tables/queries, together with your amended Powerpoint map file?
Hi, thanks for reply, I'm sending the two files de access database and the map, also it's possible to add for each freeform object a tooltip when the mouse is hover over it?
Thanks.Attachment 26568
I think it is null values as I suggested.
Try this amended query.
Code:SELECT Total_x_mun.cvemun
, Total_x_mun.municipio
, Total_x_mun.COVID19
, Total_x_mun.SOSPECHOSO
, iif(Total_x_mun.total is null, 0, Total_x_mun.total)
, catmun.shape
, Switch(total_x_mun.total=0, 1,
total_x_mun.total<=10, 2,
total_x_mun.total<=50, 3,
total_x_mun.total<=100 , 4,
total_x_mun.total<=200, 5,
TRUE, 0) AS rango
, poblacion2015.poblacion
FROM (Total_x_mun
INNER JOIN catmun ON Total_x_mun.cvemun = catmun.cvemun)
INNER JOIN poblacion2015 ON catmun.cvemun = poblacion2015.mungem
ORDER BY Total_x_mun.total DESC;
Thank you!!! :)