fix: embedded image in PPT can now be associated with an hyperlink

fix #563
davidgohel · May 5, 2024 · 2b9499e · 2b9499e
1 parent 66acdea
commit 2b9499e
Show file tree

Hide file tree

Showing 3 changed files with 8 additions and 3 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: officer
 Type: Package
 Title: Manipulation of Microsoft Word and PowerPoint Documents
-Version: 0.6.6.004
+Version: 0.6.6.005
 Authors@R: c(
     person("David", "Gohel", role = c("aut", "cre"), email = "david.gohel@ardata.fr"),
     person("Stefan", "Moog", role = "aut", email = 'moogs@gmx.de'),

diff --git a/NEWS.md b/NEWS.md
@@ -3,6 +3,7 @@
 ## Issues
 
 - Fix. Add alt text to ggplot's added to a pptx with ph_with.gg. Closes #556.
+- embedded image in PPT can now be associated with an hyperlink
 
 ## Features
 

diff --git a/R/ppt_ph_manipulate.R b/R/ppt_ph_manipulate.R
@@ -144,10 +144,14 @@ ph_slidelink <- function(x, type = "body", id = 1, id_chr = NULL, ph_label = NUL
 ph_hyperlink <- function(x, type = "body", id = 1, id_chr = NULL, ph_label = NULL, href) {
   slide <- x$slide$get_slide(x$cursor)
   office_id <- get_shape_id(x, type = type, id = id, ph_label = ph_label)
-  current_elt <- xml_find_first(slide$get(), sprintf("p:cSld/p:spTree/*[p:nvSpPr/p:cNvPr[@id='%s']]", office_id))
+  current_elt <- xml_find_first(slide$get(), sprintf("p:cSld/p:spTree/*[p:nvSpPr/p:cNvPr[@id='%s']]|p:cSld/p:spTree/*[p:nvPicPr/p:cNvPr[@id='%s']]", office_id, office_id))
 
   # add hlinkClick
-  cnvpr <- xml_child(current_elt, "p:nvSpPr/p:cNvPr")
+  if (xml_name(current_elt) %in% "pic") {
+    cnvpr <- xml_child(current_elt, "p:nvPicPr/p:cNvPr")
+  } else {
+    cnvpr <- xml_child(current_elt, "p:nvSpPr/p:cNvPr")
+  }
   str_ <- "<a:hlinkClick xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" r:id=\"%s\"/>"
   str_ <- sprintf(str_, href)
   xml_add_child(cnvpr, as_xml_document(str_))