关于Excel自动换行，不会在西文单词中间换行的问题

工作上遇到了一个Excel中换行的问题，就是使用了Excel的默认自动换行后，如果一个单词很长，那么一般情况下是不会在单词中间换行的。在网上查了些资料，最终找到了一个不算太完美的方法。

结果

就是使用vba修改单元格里面的内容，根据单元格的宽度，以及字体的字号大小来粗略的估算一行可以放多少个字，然后插入硬换行符，vba里面是chr(10)+chr(13)，大概的效果如下：
示例中的文字是：这里是 ：big computerserviceimpl是我们有的时候也不没干鲜果品轜羁 and the services are all avalible

可以看到最终的效果确实是有些差强人意，明明感觉还是可以再放一个字符的
以下是例子中使用的代码:

'允许在西文单词中间换行，插入换行符
Sub formatCellString()
    Dim c As Object
    Dim fontName As String, fontSize As Integer, defaultFontSize As Integer
    Dim str As String, count As Integer, limit As Integer
    
    '在这里指定要格式化的是哪个单元格
    Set c = Worksheets("Sheet2").Cells(1, 1)
    
    fontName = c.font.Name
    fontSize = c.font.SIZE
    Dim resultString As String
    
    '取Sheet1中第一行第1023列这个单元格的字体大小作为默认字体大小
    '需要注意的是，如果实际业务中这个单元格的字体大小也被手动修改了的话，就需要寻找其他尚未被修改过字体及字号的单元格了
    defaultFontSize = Worksheets("Sheet1").Cells(1, 1023).font.SIZE
    
    '先获取单元格的宽度，单元格宽度是在字体默认大小下的
    limit = WorksheetFunction.Ceiling(c.ColumnWidth * defaultFontSize / fontSize, 1)
    
    '要进行格式化的字符串
    str = c.Value
    For i = 1 To Len(str)
        Dim cur As Integer, curStr As String
        
        '当前字符
        curStr = Mid(str, i, 1)
        
        '取得当前字符的长度，中文算2个，其他算1个
        If StrWithChinese(curStr) Then
            cur = 2
        Else
            cur = 1
        End If
        
        '这里直接写了个2是因为有时候中英文一起的计算当前行已有宽度时会有个正好相等的问题
        If (count + 2) >= limit Then
            
            '如果再加上当前字符后，当前行长度就等于单元格宽度了，则插入一个换行符
            resultString = resultString & Chr(10) & Chr(13) & curStr
            
            ' count从头开始统计
            count = 1
            'MsgBox ("restart count:" & count & " limit:" & limit & " cur:" & cur & " curStr:" & Mid(str, i, 1) & " result：" & resultString)
        Else
            
            '统计当前行字符数
            count = count + cur
            
            '拼接结果字符
            resultString = resultString & curStr
            'MsgBox ("continue count:" & count & " limit:" & limit & " cur:" & cur & " curStr:" & Mid(str, i, 1) & " result：" & resultString)
        End If
    Next
    'c.Value = resultString '实际使用时可取消该行注释
    Worksheets("Sheet2").Cells(2, 1) = resultString '实际使用时可注释掉该行
End Sub

'判断是否包含中文字符
'源码引自：http://www.office-cn.net/excel-vba/981.html
Function StrWithChinese(StrChk As String) As Boolean
    StrChk = VBA.StrConv(StrChk, vbNarrow)
    StrWithChinese = IIf(Len(StrChk) < LenB(StrConv(StrChk, vbFromUnicode)), True, False)
End Function
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64

当然了，这个代码是把sheet2里面A1的内容插入好换行符后写入到了A2单元格，只是为了好对比效果，如果是实际使用的话，可以根据注释修改一下最后的赋值语句即可。

小结

我以为到这里就结束了，把代码放到SmartBI上，测试下就OK了，结果官方文档上说SmartBI报表并不支持Excel本身的宏。我的天!
excel上传模板不支持xlsm格式: https://wiki.smartbi.com.cn/pages/viewpage.action?pageId=76678824

由于不支持excel中的宏的执行，因此excel导入模板不支持xlsm格式的excel文件模板上传，建议将该格式修改成xls或xlsx后进行上传：

也就是说上面的都白忙活了，没法，只能再想办法。
仔细思考了下发现，虽然vba不能用，但是SmartBI人家自己也有宏的，而且是javascript语法的，那写起来不比vba好写多了(对于我来说)。
思路应该也是可以走得通的，就是获取到单元格，然后取他的字号、默认字号、列宽度，再加上原字符串，就可以计算了。但翻了一阵官方文档之后发现前三项都没法得到。那没办法了，前三项实际上只是为了自动计算那个单元格可以容纳的字符数，即然没法自动获取，那就封装成参数，在报表页面调用时手动传一个进去吧。实现的效果大致如下：

SmartBI的服务端宏的代码如下：

function main(spreadsheetReport) {
	// 将A2单元格里面的长字符串格式化成每19个字符就插入一个硬回车符
    formatStringToWrapedLine("A19", 92, 0)
}

/**
 * 根据给定的一行可容纳字符数，来插入硬回车
 * @param cell 要进行格式化的单元格
 * @param wordsLimit 一行可以容纳的字符数，excel中就是列宽，默认1000个字符
 * @param sheetIndex 当前工作薄的第几个sheet，默认0，即第一个sheet
 */
function formatStringToWrapedLine(cell, wordsLimit, sheetIndex) {
	// 用于存储for循环中每一行已累计的字符数
    var count = 0;
    // 用于拼接结果字符串
    var resultArr = [];
	// 第几个sheet，默认0，即第一个sheet页
    if (!sheetIndex) {
        sheetIndex = 0
    }
	// 每行可容纳字符数限制，默认给1000个
    if (!wordsLimit) {
        wordsLimit = 1000;
    }
	// 获得sheet页对象
    var sheet = spreadsheetReport.sheets[sheetIndex]
    // 获得指定单元格对象
    var cell = sheet.getCell(cell);
    // 单元格的值
    var str = cell.value;
    // 把原文拆成char数组
    var arr = str.split('');
    // 用于判断是否是中文的正则
    var reg = /[\u4e00-\u9fff]/
    for (var i = 0; i < arr.length; i++) {
    	// 当前char字符
        var curStr = arr[i];
        // 当前字符个数
        var curLen = 1;
        // 一个汉字占2个字符，其他的按1个算
        if (reg.test(curStr)) {
            curLen = 2;
        }
        // 如果当前行已累计的字符数 再加上2个字符长度后 >= 每行的字符限制，则插入Excel里面的硬换行符
        if (count + 2 >= wordsLimit) {
        	// 插入换行符
            resultArr.push(String.fromCharCode(10));
            resultArr.push(String.fromCharCode(13));
            // 拼接上本轮的字符
            resultArr.push(curStr);
            // 重置计数
            count = 1;
        } else {
        	// 不需要换行的话就直接拼接即可
            resultArr.push(curStr);
            count += curLen;
        }
    }
    // 指定单元格的位置
    var loc = cell.cellPosition;
    // 向指定单元格回写格式化后的字符串
    sheet.setCellValue(loc.row, loc.column, resultArr.join(''));
}
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63

好了，以下就是最初的探索的过程了，如果只是使用的话，就可以不往下看了的。

探索一 单元格像素

首先，参考下面这篇博文
EXCEL的高度和宽度计算-文档值到像素:https://blog.csdn.net/qq_30436011/article/details/126462788

找到了文中引用的官方文档
SheetFormatProperties：https://learn.microsoft.com/zh-cn/dotnet/api/documentformat.openxml.spreadsheet.sheetformatproperties?view=openxml-2.8.1

column：https://learn.microsoft.com/zh-cn/dotnet/api/documentformat.openxml.spreadsheet.column?view=openxml-2.8.1

但是我电脑上的excel打开默认列宽是8.38，和这里给出的例子都不一样，就很痛苦

探索二 字符像素

又找到一篇，可以计算指定字体下，指定字符串的总长度，像素
https://oomake.com/question/1225304
文中提出以下代码来测量字符串像素宽度

'Option Explicit
'API Declares
Private Declare Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32.dll" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32.dll" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long
Private Declare Function MulDiv Lib "kernel32.dll" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Const LOGPIXELSY As Long = 90
Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName As String * 32
End Type
Private Type SIZE
    cx As Long
    cy As Long
End Type
Public Function getLabelPixel(label As String, fontName As String, fontSize As Integer) As Integer
Dim font As New StdFont
  Dim sz As SIZE
  font.Name = fontName
  font.SIZE = fontSize
sz = GetLabelSize(label, font)
  getLabelPixel = sz.cx
End Function
Private Function GetLabelSize(text As String, font As StdFont) As SIZE
    Dim tempDC As Long
    Dim tempBMP As Long
    Dim f As Long
    Dim lf As LOGFONT
    Dim textSize As SIZE
' Create a device context and a bitmap that can be used to store a
    ' temporary font object
    tempDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0)
    tempBMP = CreateCompatibleBitmap(tempDC, 1, 1)
' Assign the bitmap to the device context
    DeleteObject SelectObject(tempDC, tempBMP)
' Set up the LOGFONT structure and create the font
    lf.lfFaceName = font.Name & Chr$(0)
    lf.lfHeight = -MulDiv(font.SIZE, GetDeviceCaps(GetDC(0), 90), 72) 'LOGPIXELSY
    lf.lfItalic = font.Italic
    lf.lfStrikeOut = font.Strikethrough
    lf.lfUnderline = font.Underline
    If font.Bold Then lf.lfWeight = 800 Else lf.lfWeight = 400
    f = CreateFontIndirect(lf)
' Assign the font to the device context
    DeleteObject SelectObject(tempDC, f)
' Measure the text, and return it into the textSize SIZE structure
    GetTextExtentPoint32 tempDC, text, Len(text), textSize
' Clean up (very important to avoid memory leaks!)
    DeleteObject f
    DeleteObject tempBMP
    DeleteDC tempDC
  ' Return the measurements
    GetLabelSize = textSize
End Function
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

探索三

换个方向，从字符数量上来入手。这个也就是最终结果采用的思路了。
这里先说一下，每个电脑上的Excel都有一个默认字体和大小，以Excel2010为例，这个设置在：文件 -> 选项 -> 常规 ->新建工作簿时这个地方

接下来理思路：

1. 参考探索一和探索二里面涉及的文章和文档来看，Excel里面的列宽度是指在默认字体及字号下的字符数。就是说如果我们打开一个Excel文件，不手动修改字体和字号的话，那么列宽是几，就可以显示出几个字符(一个汉字占两个字符)。

比如列宽是4时，可以显示4个数字或字母，或是两个中文汉字

再比如列宽是8，则可以显示8个数字或字母，或是4个中文

以上都是偶数，如果是奇数的话，中文可能就会需要换行显示了

这个字符数大致就是这样了。

2. 来看一下字号，如果我们把字号扩大一倍，那么会怎么样呢，按理说应该是显示字符数会减少一半。以下以我的Excel默认字号是11为基础。
   比如列宽设置4，字号修改为22
   
   实际测试发现字符宽度正好是4时，我们上面的推论就崩溃了。但是如果我们把宽度稍微拉大一点，比如4.38，就正好了
   
   比如把列宽拉到8.38时
   
   这样的话，也就基本符合我们(1)中的推论了。这个多出来的0.38应该就是探索一和探索二的文档中提到的margin padding以及gridline的宽度了吧。
3. 总结：根据以上两点，我们发现 修改字号后可显示字符数 = 列宽 x 默认字号 / 修改后的字号，比如2中第二个图，可显示的字符数 = 4.38 * 11 / 22 = 2.19 大概就是2个字符。至于这个小数需要怎么取舍，我没有细致研究，有能力的大佬可以把优化后的代码发出来哈。以下是根据这个思路写出来的第一版代码

'判断是否包含中文字符
Function StrWithChinese(StrChk As String) As Boolean
    StrChk = VBA.StrConv(StrChk, vbNarrow)
    StrWithChinese = IIf(Len(StrChk) < LenB(StrConv(StrChk, vbFromUnicode)), True, False)
End Function

Sub formatA1()
Dim c As Object
Dim fontName As String, fontSize As Integer, defaultFontSize As Integer
Dim str As String, count As Integer, limit As Integer
Set c = Worksheets("Sheet2").Cells(2, 1)
fontName = c.font.Name
fontSize = c.font.SIZE
Dim resultString As String
'取第一行第1023列这个单元格的字体大小作为默认字体大小
defaultFontSize = Worksheets("Sheet2").Cells(1, 1023).font.SIZE
'MsgBox defaultFontSize
'先获取单元格的宽度，单元格宽度是在字体默认大小下的
limit = WorksheetFunction.Ceiling(c.ColumnWidth * defaultFontSize / fontSize, 1)
str = Worksheets("Sheet2").Cells(1, 1).Value
For i = 1 To Len(str)
    Dim cur As Integer, curStr As String
    '当前字符
    curStr = Mid(str, i, 1)
    '中文算2个，其他算1个
    If StrWithChinese(curStr) Then
        cur = 2
    Else
        cur = 1
    End If
    '这里直接写了个2是因为有时候中英文一起的计算当前行已有宽度时会有个正好相等的问题
    If (count + 2) >= limit Then
        '如果再加上当前字符后，当前行长度就等于单元格宽度了，则插入一个换行符
        resultString = resultString & Chr(10) & Chr(13) & curStr
        ' count从头开始统计
        count = 1
        'MsgBox ("restart count:" & count & " limit:" & limit & " cur:" & cur & " curStr:" & Mid(str, i, 1) & " result：" & resultString)
    Else
        '统计当前行字符数
        count = count + cur
        '拼接结果字符
        resultString = resultString & curStr
        'MsgBox ("continue count:" & count & " limit:" & limit & " cur:" & cur & " curStr:" & Mid(str, i, 1) & " result：" & resultString)
    End If
Next
c.Value = resultString
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47