Last active
June 10, 2020 10:16
-
-
Save Finesim97/082bff8ae7f28c821b23ad9da3529ab6 to your computer and use it in GitHub Desktop.
A R function to read the Microsoft Office color palettes
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #!/usr/bin/env Rscript | |
| #' Read a Microsoft Office color palette (DrawingML) | |
| #' | |
| #' After saving a custom scheme you can find these files \href{https://answers.microsoft.com/en-us/msoffice/forum/all/where-does-powerpoint-save-color-schemes-added-in/ea2ca2ec-e238-448b-860d-ff899d4e7afc}{here}: | |
| #' \code{"%appdata%\Microsoft\Templates\Document Themes\Theme Colors"} | |
| #' | |
| #' @param file The path or content of the XML file | |
| #' @return A named character vector with the hex values | |
| #' @examples | |
| #' xml <- "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\r\n<a:clrScheme xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" name=\"Custom 1\"><a:dk1><a:sysClr val=\"windowText\" lastClr=\"000000\"/></a:dk1><a:lt1><a:sysClr val=\"window\" lastClr=\"FFFFFF\"/></a:lt1><a:dk2><a:srgbClr val=\"44546A\"/></a:dk2><a:lt2><a:srgbClr val=\"E7E6E6\"/></a:lt2><a:accent1><a:srgbClr val=\"C0F400\"/></a:accent1><a:accent2><a:srgbClr val=\"05D74D\"/></a:accent2><a:accent3><a:srgbClr val=\"2F3342\"/></a:accent3><a:accent4><a:srgbClr val=\"038B30\"/></a:accent4><a:accent5><a:srgbClr val=\"05EE55\"/></a:accent5><a:accent6><a:srgbClr val=\"70AD47\"/></a:accent6><a:hlink><a:srgbClr val=\"05D74D\"/></a:hlink><a:folHlink><a:srgbClr val=\"C0F400\"/></a:folHlink></a:clrScheme>" | |
| #' readOfficeColors(xml) | |
| readOfficeColors <- function(file){ | |
| require(xml2) | |
| xmlcontent <- read_xml(file) | |
| colors <- xml_children(xmlcontent) | |
| colornames <- xml_name(colors) | |
| colors <- xml_children(colors) | |
| colortypes <- xml_name(colors) | |
| result <- colornames | |
| result[colortypes=="sysClr"] <- xml_attr(colors[colortypes=="sysClr"],"lastClr") | |
| result[colortypes!="sysClr"] <- xml_attr(colors[colortypes!="sysClr"],"val") | |
| result <- paste0("#",result) | |
| names(result) <- colornames | |
| result | |
| } |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment