Merge pull request #499 from jistria/image-link

Inserting hyperlinked image

NEWS.md

@@ -1,3 +1,7 @@
+# openxlsx (development version)
+
+* It's now possible to insert a hyperlinked image by passing a URL, relative or absolute file path, or mailto string to the new `address` parameter of `insertImage()`.
+
 # openxlsx 4.2.7
 
 * Fixed warning on `dataValidation(..., type = "list")` ([#342](https://github.com/ycphs/openxlsx/issues/342))

R/WorkbookClass.R

@@ -3100,10 +3100,11 @@ Workbook$methods(
                          width,
                          height,
                          rowOffset = 0,
-                         colOffset = 0) {
+                         colOffset = 0,
+                         address) {
     ## within the sheet the drawing node's Id refernce an id in the sheetRels
     ## sheet rels reference the drawingi.xml file
-    ## drawingi.xml refernece drawingRels
+    ## drawingi.xml reference drawingRels
     ## drawing rels reference an image in the media folder
     ## worksheetRels(sheet(i)) references drawings(j)
 
@@ -3113,6 +3114,8 @@ Workbook$methods(
     imageType <- gsub("^\\.", "", imageType)
 
     imageNo <- length((drawings[[sheet]])) + 1L
+    imageRelNo <- length((drawings_rels[[sheet]])) + 1L
+    linkRelNo <- length((drawings_rels[[sheet]])) + 2L
     mediaNo <- length(media) + 1L
 
     startCol <- convertFromExcelRef(startCol)
@@ -3135,10 +3138,17 @@ Workbook$methods(
       drawings_rels[[sheet]],
       sprintf(
         '<Relationship Id="rId%s" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/image" Target="../media/image%s.%s"/>',
-        imageNo,
+        imageRelNo,
         mediaNo,
         imageType
-      )
+      ), 
+      if (!missing(address)) {
+        sprintf(
+          '<Relationship Id="rId%s" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink" Target="%s" TargetMode="External"/>',
+          linkRelNo,
+          address
+        )
+      }
     )
 
     ## write file path to media slot to copy across on save
@@ -3171,7 +3181,20 @@ Workbook$methods(
         width,
         height
       ),
-      genBasePic(imageNo),
+      genBasePic(
+        imageNo, 
+        imageRelNo, 
+        ifelse(
+          missing(address),
+          "/",
+          sprintf(
+            '>
+              <a:hlinkClick xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships" r:id="rId%s"/>
+            </xdr:cNvPr',
+            linkRelNo
+          )
+        )
+      ),
       "<xdr:clientData/>",
       "</xdr:oneCellAnchor>"
     )

R/baseXML.R

@@ -236,10 +236,10 @@ genBaseStyleSheet <- function(dxfs = NULL, tableStyles = NULL, extLst = NULL) {
 }
 
 
-genBasePic <- function(imageNo) {
+genBasePic <- function(imageNo, imageRelNo, hyperlinkXML) {
   sprintf('<xdr:pic xmlns:xdr="http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing">
       <xdr:nvPicPr xmlns:xdr="http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing">
-        <xdr:cNvPr xmlns:xdr="http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing" id="%s" name="Picture %s"/>
+        <xdr:cNvPr xmlns:xdr="http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing" id="%s" name="Picture %s"%s>
         <xdr:cNvPicPr xmlns:xdr="http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing">
           <a:picLocks xmlns:a="http://schemas.openxmlformats.org/drawingml/2006/main" noChangeAspect="1"/>
         </xdr:cNvPicPr>
@@ -256,7 +256,7 @@ genBasePic <- function(imageNo) {
           <a:avLst xmlns:a="http://schemas.openxmlformats.org/drawingml/2006/main"/>
         </a:prstGeom>
       </xdr:spPr>
-    </xdr:pic>', imageNo, imageNo, imageNo)
+    </xdr:pic>', imageNo, imageNo, hyperlinkXML, imageRelNo)
 }
 
 
@@ -266,8 +266,6 @@ genBasePic <- function(imageNo) {
 
 
 
-
-
 genBaseTheme <- function() {
   '<a:theme xmlns:a="http://schemas.openxmlformats.org/drawingml/2006/main" name="Office Theme">
   <a:themeElements><a:clrScheme name="Office">

R/wrappers.R

@@ -1222,6 +1222,7 @@ convert2EMU <- function(d, units) {
 #' @param startCol Column coordinate of upper left corner of the image
 #' @param units Units of width and height. Can be "in", "cm" or "px"
 #' @param dpi Image resolution used for conversion between units.
+#' @param address An optional character string specifying an external URL, relative or absolute path to a file, or mailto string (e.g. "mailto:example@@example.com") that will be opened when the image is clicked.
 #' @importFrom grDevices bmp png jpeg
 #' @seealso [insertPlot()]
 #' @export
@@ -1233,18 +1234,20 @@ convert2EMU <- function(d, units) {
 #' addWorksheet(wb, "Sheet 1")
 #' addWorksheet(wb, "Sheet 2")
 #' addWorksheet(wb, "Sheet 3")
+#' addWorksheet(wb, "Sheet 4")
 #'
 #' ## Insert images
 #' img <- system.file("extdata", "einstein.jpg", package = "openxlsx")
 #' insertImage(wb, "Sheet 1", img, startRow = 5, startCol = 3, width = 6, height = 5)
 #' insertImage(wb, 2, img, startRow = 2, startCol = 2)
 #' insertImage(wb, 3, img, width = 15, height = 12, startRow = 3, startCol = "G", units = "cm")
+#' insertImage(wb, 4, img, address = "https://github.com/ycphs/openxlsx")
 #'
 #' ## Save workbook
 #' \dontrun{
 #' saveWorkbook(wb, "insertImageExample.xlsx", overwrite = TRUE)
 #' }
-insertImage <- function(wb, sheet, file, width = 6, height = 3, startRow = 1, startCol = 1, units = "in", dpi = 300) {
+insertImage <- function(wb, sheet, file, width = 6, height = 3, startRow = 1, startCol = 1, units = "in", dpi = 300, address) {
   op <- get_set_options()
   on.exit(options(op), add = TRUE)
 
@@ -1262,6 +1265,12 @@ insertImage <- function(wb, sheet, file, width = 6, height = 3, startRow = 1, st
     stop("Invalid units.\nunits must be one of: cm, in, px")
   }
 
+  if (!missing(address)) {
+    if (!is.character(address) || length(address) != 1 || is.na(address)) {
+      stop("Invalid address. address must be a string and have a length of one.")
+    } 
+  }
+
   startCol <- convertFromExcelRef(startCol)
   startRow <- as.integer(startRow)
 
@@ -1278,7 +1287,7 @@ insertImage <- function(wb, sheet, file, width = 6, height = 3, startRow = 1, st
   widthEMU <- as.integer(round(width * 914400L, 0)) # (EMUs per inch)
   heightEMU <- as.integer(round(height * 914400L, 0)) # (EMUs per inch)
 
-  wb$insertImage(sheet, file = file, startRow = startRow, startCol = startCol, width = widthEMU, height = heightEMU)
+  wb$insertImage(sheet, file = file, startRow = startRow, startCol = startCol, width = widthEMU, height = heightEMU, address = address)
 }
 
 pixels2ExcelColWidth <- function(pixels) {

tests/testthat/test-insertImage.R

@@ -0,0 +1,52 @@
+
+context("Inserting images")
+
+test_that("Inserting hyperlinked image", {
+  # Create a workbook.
+  wb <- createWorkbook()
+  addWorksheet(wb, "Sheet 1")
+
+  # Insert multiple images. Specifically one with a link before and after other 
+  # images to test whether drawings reference the correct index of the drawing 
+  # relationships.
+  img <- system.file("extdata", "einstein.jpg", package = "openxlsx")
+  insertImage(wb, "Sheet 1", img)
+  insertImage(wb, "Sheet 1", img, address = "https://github.com/ycphs/openxlsx")
+  insertImage(wb, "Sheet 1", img)
+
+  # Declare expectations for drawings and drawings_rels xml.
+  expected_drawings <- list(
+    "<xdr:oneCellAnchor xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\"><xdr:from xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n    <xdr:col xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">0</xdr:col>\n    <xdr:colOff xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">0</xdr:colOff>\n    <xdr:row xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">0</xdr:row>\n    <xdr:rowOff xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">0</xdr:rowOff>\n  </xdr:from><xdr:ext xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\" cx=\"5486400\" cy=\"2743200\"/><xdr:pic xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n      <xdr:nvPicPr xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n        <xdr:cNvPr xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\" id=\"1\" name=\"Picture 1\"/>\n        <xdr:cNvPicPr xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n          <a:picLocks xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" noChangeAspect=\"1\"/>\n        </xdr:cNvPicPr>\n      </xdr:nvPicPr>\n      <xdr:blipFill xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n        <a:blip xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" r:embed=\"rId1\">\n        </a:blip>\n        <a:stretch xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\">\n          <a:fillRect/>\n        </a:stretch>\n      </xdr:blipFill>\n      <xdr:spPr xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n        <a:prstGeom xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" prst=\"rect\">\n          <a:avLst xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\"/>\n        </a:prstGeom>\n      </xdr:spPr>\n    </xdr:pic><xdr:clientData/></xdr:oneCellAnchor>",
+    "<xdr:oneCellAnchor xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\"><xdr:from xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n    <xdr:col xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">0</xdr:col>\n    <xdr:colOff xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">0</xdr:colOff>\n    <xdr:row xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">0</xdr:row>\n    <xdr:rowOff xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">0</xdr:rowOff>\n  </xdr:from><xdr:ext xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\" cx=\"5486400\" cy=\"2743200\"/><xdr:pic xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n      <xdr:nvPicPr xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n        <xdr:cNvPr xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\" id=\"2\" name=\"Picture 2\">\n              <a:hlinkClick xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" r:id=\"rId3\"/>\n            </xdr:cNvPr>\n        <xdr:cNvPicPr xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n          <a:picLocks xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" noChangeAspect=\"1\"/>\n        </xdr:cNvPicPr>\n      </xdr:nvPicPr>\n      <xdr:blipFill xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n        <a:blip xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" r:embed=\"rId2\">\n        </a:blip>\n        <a:stretch xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\">\n          <a:fillRect/>\n        </a:stretch>\n      </xdr:blipFill>\n      <xdr:spPr xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n        <a:prstGeom xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" prst=\"rect\">\n          <a:avLst xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\"/>\n        </a:prstGeom>\n      </xdr:spPr>\n    </xdr:pic><xdr:clientData/></xdr:oneCellAnchor>",
+    "<xdr:oneCellAnchor xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\"><xdr:from xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n    <xdr:col xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">0</xdr:col>\n    <xdr:colOff xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">0</xdr:colOff>\n    <xdr:row xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">0</xdr:row>\n    <xdr:rowOff xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">0</xdr:rowOff>\n  </xdr:from><xdr:ext xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\" cx=\"5486400\" cy=\"2743200\"/><xdr:pic xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n      <xdr:nvPicPr xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n        <xdr:cNvPr xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\" id=\"3\" name=\"Picture 3\"/>\n        <xdr:cNvPicPr xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n          <a:picLocks xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" noChangeAspect=\"1\"/>\n        </xdr:cNvPicPr>\n      </xdr:nvPicPr>\n      <xdr:blipFill xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n        <a:blip xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" r:embed=\"rId4\">\n        </a:blip>\n        <a:stretch xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\">\n          <a:fillRect/>\n        </a:stretch>\n      </xdr:blipFill>\n      <xdr:spPr xmlns:xdr=\"http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing\">\n        <a:prstGeom xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" prst=\"rect\">\n          <a:avLst xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\"/>\n        </a:prstGeom>\n      </xdr:spPr>\n    </xdr:pic><xdr:clientData/></xdr:oneCellAnchor>"
+  )
+  expected_drawings_rels <- list(
+    "<Relationship Id=\"rId1\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/image\" Target=\"../media/image1.jpg\"/>",
+    "<Relationship Id=\"rId2\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/image\" Target=\"../media/image2.jpg\"/>",
+    "<Relationship Id=\"rId3\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink\" Target=\"https://github.com/ycphs/openxlsx\" TargetMode=\"External\"/>",
+    "<Relationship Id=\"rId4\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/image\" Target=\"../media/image3.jpg\"/>"
+  )
+
+  # Test expectations for drawings and drawings_rels xml.
+  expect_equal(expected_drawings, wb$drawings[[1]])
+  expect_equal(expected_drawings_rels, wb$drawings_rels[[1]])
+
+  # Test errors.
+  expect_error(
+    insertImage(wb, "Sheet 1", img, address = NULL), 
+    "Invalid address"
+  )
+  expect_error(
+    insertImage(wb, "Sheet 1", img, address = NA), 
+    "Invalid address"
+  )
+  expect_error(
+    insertImage(
+      wb, 
+      "Sheet 1", 
+      img, 
+      address = c("https://github.com/ycphs/openxlsx", "https://github.com/ycphs/openxlsx/issues")
+    ), 
+    "Invalid address"
+  )
+})