Automatic (slides) for the people (Last updated: 2025-06-18)
Creating and saving multiple plots to Powerpoint
At the NHS R conference we delivered a session on animating patient flow. This started with a single plot showing all patient movements, and then I demonstrated the ability to create a faceted plot.
But, with many different areas, and a small plot space, the faceted plot was a bit meh really.
So what else could we do?
How about creating individual plots for each ward area? And saving them into Powerpoint for onward distribution?
All the files you need to recreate this are on the repo. If all goes well, you should create a series of images, and also save these to a powerpoint ready for onward distribution to the sort of folk who think spreadsheets are where it’s at.
# some wards have very few movements, but how many? source("1_setup.R") source("2_data_wrangling.R") library(officer) library(magrittr) setwd(here::here()) # how many obs per group? # base R: table(data$Ward_Dept) # succinct, but the output is not great..how it looks, structure etc # using dplyr we get a tibble, which is a more useful output plot_data %>% group_by(Ward_Dept) %>% count() %>% #arrange in descending order arrange(desc(n)) ## create a list of distinct ward names places <- plot_data %>% distinct(Ward_Dept) %>% rename(Location = Ward_Dept) #create plot function png_plot <- function(Location) { plot_colours <- c("orangered1","royalblue2","grey60") tempdf <- plot_data %>% filter(Ward_Dept == Location) ggplot(plot_data,aes(Movement15, Movement_15_SEQNO,colour = Movement_Type)) + geom_point(alpha = 0) + geom_point(data = tempdf,aes(Movement15,Movement_15_SEQNO,colour = Movement_Type), na.rm = FALSE) + scale_colour_manual(values = plot_colours,drop = FALSE) + scale_x_datetime(date_labels = "%H:%M",date_breaks = "3 hours", limits = lims, timezone = "GMT", expand = c(0,0)) + scale_y_continuous(breaks = seq(-15,15, by = 5), limits = c(-15,15)) + expand_limits(y = c(-15, 15)) + ggtitle(label = "Anytown General Hospital | Wednesday 3rd September 2014 00:00 to 23:59\n", subtitle = paste0(Location," ARRIVALS, DEPARTURES AND TRANSFERS")) + labs(x = NULL, y = NULL,caption = "NHS-R conference") + theme_minimal(base_size = 11) + theme(legend.position = "bottom") + theme(panel.grid.minor = element_blank()) + theme(strip.text.y = element_text(angle = 180)) + guides(color = guide_legend("Movement Type")) ggsave(filename = paste0(Location,".png"), width = 10, height = 8) } # create a folder to store .png files dir.create(here::here("png")) setwd(here::here("png")) ## any errors here - did you create the folder in the first place? # now use the walk function from purrr to create an image per location walk(places$Location,png_plot) #check your ".png" folder #now copy a blank powerpoint template from home directory to current "png" directory # file.copy(where from, what, where to) file.copy(file.path(here::here(),"blank.pptx"), getwd()) ############## automating powerpoint slides using officer ############### # Set a footer set_ftr <- "NHS_R Conference Oct 2018" set_pres <- read_pptx("blank.pptx") %>% # Load template Add a slide add_slide(layout = "Title Slide", master = "Office Theme") %>% # Add some text to the title (ctrTitle) ph_with_text(type = "ctrTitle", str = "Drill Down to Individual Location") %>% # Add some text to the subtitle (subTitle) ph_with_text(type = "subTitle", str = "Individual Location Plots") %>% ph_with_text(type = "ftr", str = set_ftr) slidef <- function(places, pres = set_pres) { set_pres %>% add_slide(layout = "Title and Content", master = "Office Theme") %>% ph_with_text(type = "ftr", str = set_ftr) %>% ph_with_img(type = "body", index = 1, src = paste0(places, ".png")) -> set_pres # get images } walk(places$Location, slidef) set_pres %>% print(target = "All Wards.pptx") %>% invisible() ## hooray # move the powerpoints elsewhere, then delete them from current folder filestomove <- c("All Wards.pptx","blank.pptx") file.copy(file.path(getwd(),filestomove), here::here()) file.remove(filestomove) #make sure you are still in the png folder getwd() filenames <- dir() library(gifski) gifski(png_files = filenames, gif_file = "Location_animation.gif", width = 800, height = 600, delay = 1, loop = TRUE, progress = TRUE) utils::browseURL("Location_animation.gif") # stick this in a powerpoint too? file.copy(file.path(here::here(),"blank.pptx"), getwd()) # Set a footer set_ftr <- "NHS_R Conference Oct 2018" set_pres <- read_pptx("blank.pptx") %>% # Load template Add a slide add_slide(layout = "Title Slide", master = "Office Theme") %>% # Add some text to the title (ctrTitle) ph_with_text(type = "ctrTitle", str = "Individual Location Animation") %>% # Add some text to the subtitle (subTitle) ph_with_text(type = "subTitle", str = "Individual Location Plots gif") %>% ph_with_text(type = "ftr", str = set_ftr) set_pres %>% add_slide(layout = "Title and Content", master = "Office Theme") %>% ph_with_text(type = "ftr", str = set_ftr) %>% ph_with_img(type = "body", index = 1, src = "Location_animation.gif") -> set_pres # get images set_pres %>% print(target = "Animation.pptx") %>% invisible() # move the powerpoints to the root of the folder, then delete them from current folder filestomove <- c("Animation.pptx","Location_animation.gif","blank.pptx") file.copy(file.path(getwd(),filestomove), here::here()) file.remove(filestomove) #go back home setwd(here::here()) There you have it. Credit to Len Keifer, who’s code I borrowed liberally (found it, pinched it) in order to create the slides in powerpoint. These techniques have saved me a lot of time each month - with a small bit of setup time, regular reporting can be automated, giving you time to work on the harder stuff.
Hey there! Just so you know, we've updated this article with the latest info, and we’ve even added some extra content specifically for our friends in the Japanese region. If you're curious to dive deeper, feel free to click the link below to check out the full piece!
https://www.johnmackintosh.net/jp/article/31/automate-patient-flow-visualization-seo。
