1 2genBaseColStyle <- function(cc) { 3 colStyle <- createStyle() 4 specialFormat <- TRUE 5 6 if ("date" %in% cc) { 7 colStyle <- createStyle(numFmt = "date") 8 } else if (any(c("posixlt", "posixct", "posixt") %in% cc)) { 9 colStyle <- createStyle(numFmt = "longdate") 10 } else if ("currency" %in% cc) { 11 colStyle$numFmt <- list(numFmtId = "164", "formatCode" = ""$"#,##0.00") 12 } else if ("accounting" %in% cc) { 13 colStyle$numFmt <- list(numFmtId = "44") 14 } else if ("hyperlink" %in% cc) { 15 colStyle$fontColour <- list(theme = "10") 16 } else if ("percentage" %in% cc) { 17 colStyle$numFmt <- list(numFmtId = "10") 18 } else if ("scientific" %in% cc) { 19 colStyle$numFmt <- list(numFmtId = "11") 20 } else if (any(c("3", "comma") %in% cc)) { 21 colStyle$numFmt <- list(numFmtId = "3") 22 } else if ("numeric" %in% cc & !grepl("[^0\\.,#\\$\\* %]", openxlsx_getOp("numFmt"))) { 23 colStyle$numFmt <- list(numFmtId = 9999, formatCode = openxlsx_getOp("numFmt")) 24 } else { 25 colStyle$numFmt <- list(numFmtId = "0") 26 specialFormat <- FALSE 27 } 28 29 list( 30 style = colStyle, 31 specialFormat = specialFormat 32 ) 33} 34 35 36 37Workbook$methods(surroundingBorders = function( 38 colClasses, 39 sheet, 40 startRow, 41 startCol, 42 nRow, 43 nCol, 44 borderColour, 45 borderStyle, 46 borderType 47) { 48 sheet <- sheet_names[[validateSheet(sheet)]] 49 ## steps 50 # get column class 51 # get corresponding base style 52 53 for (i in 1:nCol) { 54 tmp <- genBaseColStyle(colClasses[[i]]) 55 56 colStyle <- tmp$style 57 specialFormat <- tmp$specialFormat 58 59 ## create style objects 60 sTop <- colStyle$copy() 61 sMid <- colStyle$copy() 62 sBot <- colStyle$copy() 63 64 ## First column 65 if (i == 1) { 66 if (nRow == 1 & nCol == 1) { 67 68 ## All 69 sTop$borderTop <- borderStyle 70 sTop$borderTopColour <- borderColour 71 72 sTop$borderBottom <- borderStyle 73 sTop$borderBottomColour <- borderColour 74 75 sTop$borderLeft <- borderStyle 76 sTop$borderLeftColour <- borderColour 77 78 sTop$borderRight <- borderStyle 79 sTop$borderRightColour <- borderColour 80 81 styleObjects <<- append(styleObjects, list( 82 list( 83 "style" = sTop, 84 "sheet" = sheet, 85 "rows" = startRow, 86 "cols" = startCol 87 ) 88 )) 89 } else if (nCol == 1) { 90 91 ## Top 92 sTop$borderLeft <- borderStyle 93 sTop$borderLeftColour <- borderColour 94 95 sTop$borderTop <- borderStyle 96 sTop$borderTopColour <- borderColour 97 98 sTop$borderRight <- borderStyle 99 sTop$borderRightColour <- borderColour 100 101 ## Middle 102 sMid$borderLeft <- borderStyle 103 sMid$borderLeftColour <- borderColour 104 105 sMid$borderRight <- borderStyle 106 sMid$borderRightColour <- borderColour 107 108 ## Bottom 109 sBot$borderBottom <- borderStyle 110 sBot$borderBottomColour <- borderColour 111 112 sBot$borderLeft <- borderStyle 113 sBot$borderLeftColour <- borderColour 114 115 sBot$borderRight <- borderStyle 116 sBot$borderRightColour <- borderColour 117 118 styleObjects <<- append(styleObjects, list( 119 list( 120 "style" = sTop, 121 "sheet" = sheet, 122 "rows" = startRow, 123 "cols" = startCol 124 ) 125 )) 126 127 styleObjects <<- append(styleObjects, list( 128 list( 129 "style" = sMid, 130 "sheet" = sheet, 131 "rows" = (startRow + 1L):(startRow + nRow - 2L), # 2nd -> 2nd to last 132 "cols" = rep.int(startCol, nRow - 2L) 133 ) 134 )) 135 136 styleObjects <<- append(styleObjects, list( 137 list( 138 "style" = sBot, 139 "sheet" = sheet, 140 "rows" = startRow + nRow - 1L, 141 "cols" = startCol 142 ) 143 )) 144 } else if (nRow == 1) { 145 146 ## All 147 sTop$borderTop <- borderStyle 148 sTop$borderTopColour <- borderColour 149 150 sTop$borderBottom <- borderStyle 151 sTop$borderBottomColour <- borderColour 152 153 sTop$borderLeft <- borderStyle 154 sTop$borderLeftColour <- borderColour 155 156 styleObjects <<- append(styleObjects, list( 157 list( 158 "style" = sTop, 159 "sheet" = sheet, 160 "rows" = startRow, 161 "cols" = startCol 162 ) 163 )) 164 } else { 165 166 ## Top 167 sTop$borderLeft <- borderStyle 168 sTop$borderLeftColour <- borderColour 169 170 sTop$borderTop <- borderStyle 171 sTop$borderTopColour <- borderColour 172 173 ## Middle 174 sMid$borderLeft <- borderStyle 175 sMid$borderLeftColour <- borderColour 176 177 ## Bottom 178 sBot$borderLeft <- borderStyle 179 sBot$borderLeftColour <- borderColour 180 181 sBot$borderBottom <- borderStyle 182 sBot$borderBottomColour <- borderColour 183 184 styleObjects <<- append(styleObjects, list( 185 list( 186 "style" = sTop, 187 "sheet" = sheet, 188 "rows" = startRow, 189 "cols" = startCol 190 ) 191 )) 192 193 if (nRow > 2) { 194 styleObjects <<- append(styleObjects, list( 195 list( 196 "style" = sMid, 197 "sheet" = sheet, 198 "rows" = (startRow + 1L):(startRow + nRow - 2L), # 2nd -> 2nd to last 199 "cols" = rep.int(startCol, nRow - 2L) 200 ) 201 )) 202 } 203 204 styleObjects <<- append(styleObjects, list( 205 list( 206 "style" = sBot, 207 "sheet" = sheet, 208 "rows" = startRow + nRow - 1L, 209 "cols" = startCol 210 ) 211 )) 212 } 213 } else if (i == nCol) { 214 if (nRow == 1) { 215 216 ## All 217 sTop$borderTop <- borderStyle 218 sTop$borderTopColour <- borderColour 219 220 sTop$borderBottom <- borderStyle 221 sTop$borderBottomColour <- borderColour 222 223 sTop$borderRight <- borderStyle 224 sTop$borderRightColour <- borderColour 225 226 styleObjects <<- append(styleObjects, list( 227 list( 228 "style" = sTop, 229 "sheet" = sheet, 230 "rows" = startRow, 231 "cols" = startCol + nCol - 1L 232 ) 233 )) 234 } else { 235 236 ## Top 237 sTop$borderRight <- borderStyle 238 sTop$borderRightColour <- borderColour 239 240 sTop$borderTop <- borderStyle 241 sTop$borderTopColour <- borderColour 242 243 ## Middle 244 sMid$borderRight <- borderStyle 245 sMid$borderRightColour <- borderColour 246 247 ## Bottom 248 sBot$borderRight <- borderStyle 249 sBot$borderRightColour <- borderColour 250 251 sBot$borderBottom <- borderStyle 252 sBot$borderBottomColour <- borderColour 253 254 styleObjects <<- append(styleObjects, list( 255 list( 256 "style" = sTop, 257 "sheet" = sheet, 258 "rows" = startRow, 259 "cols" = startCol + nCol - 1L 260 ) 261 )) 262 263 if (nRow > 2) { 264 styleObjects <<- append(styleObjects, list( 265 list( 266 "style" = sMid, 267 "sheet" = sheet, 268 "rows" = (startRow + 1L):(startRow + nRow - 2L), # 2nd -> 2nd to last 269 "cols" = rep.int(startCol + nCol - 1L, nRow - 2L) 270 ) 271 )) 272 } 273 274 275 styleObjects <<- append(styleObjects, list( 276 list( 277 "style" = sBot, 278 "sheet" = sheet, 279 "rows" = startRow + nRow - 1L, 280 "cols" = startCol + nCol - 1L 281 ) 282 )) 283 } 284 } else { ## inside columns 285 286 if (nRow == 1) { 287 288 ## Top 289 sTop$borderTop <- borderStyle 290 sTop$borderTopColour <- borderColour 291 292 ## Bottom 293 sTop$borderBottom <- borderStyle 294 sTop$borderBottomColour <- borderColour 295 296 styleObjects <<- append(styleObjects, list( 297 list( 298 "style" = sTop, 299 "sheet" = sheet, 300 "rows" = startRow, 301 "cols" = startCol + i - 1L 302 ) 303 )) 304 } else { 305 306 ## Top 307 sTop$borderTop <- borderStyle 308 sTop$borderTopColour <- borderColour 309 310 ## Bottom 311 sBot$borderBottom <- borderStyle 312 sBot$borderBottomColour <- borderColour 313 314 styleObjects <<- append(styleObjects, list( 315 list( 316 "style" = sTop, 317 "sheet" = sheet, 318 "rows" = startRow, 319 "cols" = startCol + i - 1L 320 ) 321 )) 322 323 ## Middle 324 if (specialFormat) { 325 styleObjects <<- append(styleObjects, list( 326 list( 327 "style" = sMid, 328 "sheet" = sheet, 329 "rows" = (startRow + 1L):(startRow + nRow - 2L), # 2nd -> 2nd to last 330 "cols" = rep.int(startCol + i - 1L, nRow - 2L) 331 ) 332 )) 333 } 334 335 styleObjects <<- append(styleObjects, list( 336 list( 337 "style" = sBot, 338 "sheet" = sheet, 339 "rows" = startRow + nRow - 1L, 340 "cols" = startCol + i - 1L 341 ) 342 )) 343 } 344 } ## End of if(i == 1), i == NCol, else inside columns 345 } ## End of loop through columns 346 347 348 invisible(0) 349}) 350 351Workbook$methods(rowBorders = function( 352 colClasses, 353 sheet, 354 startRow, 355 startCol, 356 nRow, 357 nCol, 358 borderColour, 359 borderStyle, 360 borderType 361) { 362 sheet <- sheet_names[[validateSheet(sheet)]] 363 ## steps 364 # get column class 365 # get corresponding base style 366 367 for (i in 1:nCol) { 368 tmp <- genBaseColStyle(colClasses[[i]]) 369 sTop <- tmp$style 370 371 ## First column 372 if (i == 1) { 373 if (nCol == 1) { 374 375 ## All borders (rows and surrounding) 376 sTop$borderTop <- borderStyle 377 sTop$borderTopColour <- borderColour 378 379 sTop$borderBottom <- borderStyle 380 sTop$borderBottomColour <- borderColour 381 382 sTop$borderLeft <- borderStyle 383 sTop$borderLeftColour <- borderColour 384 385 sTop$borderRight <- borderStyle 386 sTop$borderRightColour <- borderColour 387 } else { 388 389 ## Top, Left, Bottom 390 sTop$borderTop <- borderStyle 391 sTop$borderTopColour <- borderColour 392 393 sTop$borderBottom <- borderStyle 394 sTop$borderBottomColour <- borderColour 395 396 sTop$borderLeft <- borderStyle 397 sTop$borderLeftColour <- borderColour 398 } 399 } else if (i == nCol) { 400 401 ## Top, Right, Bottom 402 sTop$borderTop <- borderStyle 403 sTop$borderTopColour <- borderColour 404 405 sTop$borderBottom <- borderStyle 406 sTop$borderBottomColour <- borderColour 407 408 sTop$borderRight <- borderStyle 409 sTop$borderRightColour <- borderColour 410 } else { ## inside columns 411 412 ## Top, Middle, Bottom 413 sTop$borderTop <- borderStyle 414 sTop$borderTopColour <- borderColour 415 416 sTop$borderBottom <- borderStyle 417 sTop$borderBottomColour <- borderColour 418 } ## End of if(i == 1), i == NCol, else inside columns 419 420 styleObjects <<- append(styleObjects, list( 421 list( 422 "style" = sTop, 423 "sheet" = sheet, 424 "rows" = (startRow):(startRow + nRow - 1L), 425 "cols" = rep(startCol + i - 1L, nRow) 426 ) 427 )) 428 } ## End of loop through columns 429 430 431 invisible(0) 432}) 433 434 435Workbook$methods(columnBorders = function( 436 colClasses, 437 sheet, 438 startRow, 439 startCol, 440 nRow, 441 nCol, 442 borderColour, 443 borderStyle, 444 borderType 445) { 446 sheet <- sheet_names[[validateSheet(sheet)]] 447 ## steps 448 # get column class 449 # get corresponding base style 450 451 for (i in 1:nCol) { 452 tmp <- genBaseColStyle(colClasses[[i]]) 453 colStyle <- tmp$style 454 specialFormat <- tmp$specialFormat 455 456 ## create style objects 457 sTop <- colStyle$copy() 458 sMid <- colStyle$copy() 459 sBot <- colStyle$copy() 460 461 if (nRow == 1) { 462 463 ## Top 464 sTop$borderTop <- borderStyle 465 sTop$borderTopColour <- borderColour 466 467 sTop$borderBottom <- borderStyle 468 sTop$borderBottomColour <- borderColour 469 470 sTop$borderLeft <- borderStyle 471 sTop$borderLeftColour <- borderColour 472 473 sTop$borderRight <- borderStyle 474 sTop$borderRightColour <- borderColour 475 476 styleObjects <<- append(styleObjects, list( 477 list( 478 "style" = sTop, 479 "sheet" = sheet, 480 "rows" = startRow, 481 "cols" = startCol + i - 1L 482 ) 483 )) 484 } else { 485 486 ## Top 487 sTop$borderTop <- borderStyle 488 sTop$borderTopColour <- borderColour 489 490 sTop$borderLeft <- borderStyle 491 sTop$borderLeftColour <- borderColour 492 493 sTop$borderRight <- borderStyle 494 sTop$borderRightColour <- borderColour 495 496 ## Middle 497 sMid$borderLeft <- borderStyle 498 sMid$borderLeftColour <- borderColour 499 500 sMid$borderRight <- borderStyle 501 sMid$borderRightColour <- borderColour 502 503 ## Bottom 504 sBot$borderBottom <- borderStyle 505 sBot$borderBottomColour <- borderColour 506 507 sBot$borderLeft <- borderStyle 508 sBot$borderLeftColour <- borderColour 509 510 sBot$borderRight <- borderStyle 511 sBot$borderRightColour <- borderColour 512 513 colInd <- startCol + i - 1L 514 515 styleObjects <<- append(styleObjects, list( 516 list( 517 "style" = sTop, 518 "sheet" = sheet, 519 "rows" = startRow, 520 "cols" = colInd 521 ) 522 )) 523 524 if (nRow > 2) { 525 styleObjects <<- append(styleObjects, list( 526 list( 527 "style" = sMid, 528 "sheet" = sheet, 529 "rows" = (startRow + 1L):(startRow + nRow - 2L), 530 "cols" = rep(colInd, nRow - 2L) 531 ) 532 )) 533 } 534 535 styleObjects <<- append(styleObjects, list( 536 list( 537 "style" = sBot, 538 "sheet" = sheet, 539 "rows" = startRow + nRow - 1L, 540 "cols" = colInd 541 ) 542 )) 543 } 544 } ## End of loop through columns 545 546 547 invisible(0) 548}) 549 550 551Workbook$methods(allBorders = function( 552 colClasses, 553 sheet, 554 startRow, 555 startCol, 556 nRow, 557 nCol, 558 borderColour, 559 borderStyle, 560 borderType 561) { 562 sheet <- sheet_names[[validateSheet(sheet)]] 563 ## steps 564 # get column class 565 # get corresponding base style 566 567 for (i in 1:nCol) { 568 tmp <- genBaseColStyle(colClasses[[i]]) 569 sTop <- tmp$style 570 571 ## All borders 572 sTop$borderTop <- borderStyle 573 sTop$borderTopColour <- borderColour 574 575 sTop$borderBottom <- borderStyle 576 sTop$borderBottomColour <- borderColour 577 578 sTop$borderLeft <- borderStyle 579 sTop$borderLeftColour <- borderColour 580 581 sTop$borderRight <- borderStyle 582 sTop$borderRightColour <- borderColour 583 584 styleObjects <<- append(styleObjects, list( 585 list( 586 "style" = sTop, 587 "sheet" = sheet, 588 "rows" = (startRow):(startRow + nRow - 1L), 589 "cols" = rep(startCol + i - 1L, nRow) 590 ) 591 )) 592 } ## End of loop through columns 593 594 595 invisible(0) 596}) 597