我想创建一个带有突出显示标签的模板。标记应替换为带有 的一些数据R
。我在模板文件中突出显示了文本,并希望输出文件中有空白背景。
我已经尝试过officer
,因为这似乎是最成熟R
的处理word
文档的包。我已经尝试过body_replace_all_text
andbody_replace_text_at_bkm
功能,但似乎都没有提供更改格式的选项。
我对不同的方法完全持开放态度。硬性要求是模板和输出文件必须可由非技术同事编辑(因此是 word 文档),并且模板中的输入字段必须以某种方式突出显示。这意味着如果同事手动编辑模板,他不会错过任何标签。
代码
library(officer)
library(magrittr)
template <- read_docx("template.docx")
pattern <- "<tags>"
replacement <- "tags"
template <- template %>%
body_replace_all_text(pattern, replacement)
pattern <- "<color.*?/color>"
replacement <- "yellow"
template <- template %>%
body_replace_all_text(pattern, replacement)
print(template, target = "output.docx")
模板.docx
输出.docx
desired_output.docx
编辑
officer
通过猴子补丁包解决了这个问题。这有点骇人听闻,所以我仍然愿意寻求更清洁的解决方案。
replace_all_text.custom = function( oldValue, newValue, onlyAtCursor=TRUE, warn = TRUE, ... ) {
oldValue <- enc2utf8(oldValue)
newValue <- enc2utf8(newValue)
replacement_count <- 0
base_node <- if (onlyAtCursor) self$get_at_cursor() else self$get()
# For each matching text node...
for (text_node in xml_find_all(base_node, ".//w:t")) {
# ...if it contains the oldValue...
if (grepl(oldValue, xml_text(text_node), ...)) {
replacement_count <- replacement_count + 1
# Replace the node text with the newValue.
xml_text(text_node) <- gsub(oldValue, newValue, xml_text(text_node), ...)
# remove background color
xml_remove(xml_find_all(text_node, "..//w:highlight"))
}
}
# Alert the user if no replacements were made.
if (replacement_count == 0 && warn) {
search_zone_text <- if (onlyAtCursor) "at the cursor." else "in the document."
warning("Found 0 instances of '", oldValue, "' ", search_zone_text)
}
self
}
docx_part.custom <- officer:::docx_part
docx_part.custom$public_methods$replace_all_text <- replace_all_text.custom
assignInNamespace("docx_part", docx_part.custom, ns = "officer")