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" = "&quot;$&quot;#,##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