专家坐堂-莫名其妙的空格Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  莫名其妙的空格  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=41360)

--  作者：东坡一剑
--  发布时间：2013/10/17 16:38:00
--  莫名其妙的空格

我想达到这样的目的：

通过foxtable操控Excel

1、在同一个单元格内，"品牌"及其内容靠左对齐，"品名"及其内容靠右对齐，两者之间至少保持一个空格位置

2、如果在默认字号大小时，字符串的总长度超过单元格长度，则缩小"品名"内容的字号，使字符串总长度刚好等于单元格长度。

下载信息  [文件大小：   下载次数： ]
点击浏览该文件:莫名其妙的空格.zip

却发现了一个奇怪的问题：

随着s3字数的增加，Rg("A3")的值会在末尾自动增加空格，始终无法达到右对齐的目的。当字体大小不变时，当s3的值只有一个字时，空格长度为差一点2个字宽，空格的长度随s3的字数增加而增加，增加值为每增加一个汉字，空格大约增加0.7个字宽，字体变小时，仍是一种正比关系，具体比例未测量。这些空格极其讨厌，怎么trim都trim不掉！

不知问题出在哪里，附上例子，恳请诸位帮忙！

[此贴子已经被作者于2013-10-17 17:38:13编辑过]

--  作者：东坡一剑
--  发布时间：2013/10/17 20:24:00
--
有没有高手帮忙啊！

--  作者：有点甜
--  发布时间：2013/10/17 21:05:00
--
看了下，如下代码，测试有效。

Dim fl As String = ProjectPath & "结果.xls"
Dim s0,s1,s2,s3 As String
Dim chr As MSExcel.Characters
s0 = " "
s1 = "品牌:中国牌"
s2 = "品名:"
s3 = "一二三四五六七八九十一二三四五快快快快六七八九十"

Dim App As New MSExcel.Application
App.displayAlerts = False
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rg As MSExcel.Range = Ws.Range("A3")

Rg.value = s1 & s2 & s3.trim()
chr= Rg.Characters(s1.length + s2.length + 1,s3.length)

Dim i As Integer
Dim defFontSize = 16
Dim Range = ws.Range("A3")
Dim width = Rg.width * 4 / 3
Dim graphics As Graphics = Forms("窗口2").baseform.CreateGraphics
Dim sizeF = graphics.MeasureString(s1 & s2, new Font("宋体", defFontSize))
width = width - sizeF.width

For i = defFontSize*2 To 1 Step -1
sizeF = graphics.MeasureString(s3, new Font("宋体", i/2))
If sizeF.width <= width Then
chr= Rg.Characters(s1.length + s2.length + 1,s3.length)
chr.font.size = i/2
Dim sizeF0 = graphics.MeasureString(s0, new Font("宋体", defFontSize))
Dim sizeF1 = graphics.MeasureString(s1, new Font("宋体", defFontSize))
Dim sizeF2 = graphics.MeasureString(s2, new Font("宋体", defFontSize))
Dim j As Integer = 1
Do While sizeF0.width*(j-3) + sizeF1.width + sizeF2.width + sizeF.width <= rg.width * 4 / 3
j += 1
Loop
j -= 1
rg.value = s1.PadRight(s1.Length+j) & s2 & s3
chr= Rg.Characters(s1.length + s2.length + j + 1,s3.length)
chr.font.size = i/2
Exit For
End If
Next
wb.save
App.visible = True

--  作者：东坡一剑
--  发布时间：2013/10/17 22:02:00
--

甜老师：s3 的字数多于7时代码是有效的，少于7则空格逐渐加大。上面的代码也是无效的。

我折腾了一天，直到刚才，应该是发现了问题的要害所在：4/3这个系数是一个精度不够的近似数造成的，只要换成一个精度更高的近似数应该就可以解决问题！

[此贴子已经被作者于2013-10-17 22:10:55编辑过]

--  作者：东坡一剑
--  发布时间：2013/10/17 22:09:00
--

其实字数10是一个临界点，10以上，字号开始变化插入空格的代码不起作用，因此不会出错，7以上，误差尚未累积到肉眼可以观察的程度，因此看起来也是正常的。

我的代码如下，测试结果和你的一样：

Dim fl As String = ProjectPath & "结果.xls"
Dim s0,s1,s2,s3 As String
Dim chr As MSExcel.Characters
s0 = " "
s1 = "品牌:中国牌"
s2 = "品名:"
s3 = "一二" \'三四五六七八九十一二三四五六七八九十

Dim App As New MSExcel.Application
App.displayAlerts = False
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rg As MSExcel.Range = Ws.Range("A3")
Rg.value = s1 & s0 & s2 & s3
chr= Rg.Characters((s1 & s0 & s2).length + 1,s3.length)

Dim i As Integer
Dim defFontSize = Rg.Font.size
Dim Range = ws.Range("A3")
Dim width = Rg.width *4/3
Dim graphics As Graphics = Forms("窗口2").baseform.CreateGraphics
Dim sizeF = graphics.MeasureString(s1 & s2, new Font("宋体", defFontSize))
width = width - sizeF.width

For i = defFontSize*2 To 1 Step -1
    sizeF = graphics.MeasureString(s3, new Font("宋体", i/2))
    If sizeF.width <= width Then
        chr.font.size = i/2
        Exit For
    End If
Next

i = 0
If chr.font.size = defFontSize Then
    Dim sizeF0 = graphics.MeasureString(s0, new Font("宋体",defFontSize))
    width = Rg.width
    MessageBox.Show("格子=" & width)
    sizeF = graphics.MeasureString(s1 & s0 & s2 & s3, new Font("宋体", Rg.font.size))
    width = width - sizeF.width *3/4
    MessageBox.Show("字长=" & sizeF.width)
    width = width/sizeF0.width
    MessageBox.Show("差比=" & width)
    If width > 1 Then
        i = CInt(width)
    Else
        i = 0
    End If
End If

If i > 0 Then
    s0 = New String(" ", i)

    MessageBox.Show("i=" & i)
    Dim s33 = graphics.MeasureString(s0, new Font("宋体", defFontSize))
    MessageBox.Show("s33=" & s33.width)
    Rg.value = s1 & s0 & s2 & s3
    MessageBox.Show(Rg.value.length)
    Rg.font.size = defFontSize
End If
wb.save
App.visible = True

--  作者：有点甜
--  发布时间：2013/10/17 22:14:00
--
没有完美的，特别字符串长度，更是没谱。

--  作者：有点甜
--  发布时间：2013/10/17 22:44:00
--
再试了一下，是空格宽度的问题，应该是11的。

Dim fl As String = ProjectPath & "结果.xls"
Dim s0,s1,s2,s3 As String
Dim chr As MSExcel.Characters
s0 = " "
s1 = "品牌:中国牌"
s2 = "品名:"
s3 = "一七八九八九八九八九八九八九八九八九八九八九八九八九八九八九八九八九八九八九十"

Dim App As New MSExcel.Application
App.displayAlerts = False
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rg As MSExcel.Range = Ws.Range("A4")

Rg.value = s1 & s2 & s3.trim()
chr= Rg.Characters(s1.length + s2.length + 1,s3.length)

Dim i As Integer
Dim defFontSize = 16
Dim Range = ws.Range("A3")
Dim width = Rg.width * 4 / 3
Dim graphics As Graphics = Forms("窗口2").baseform.CreateGraphics
Dim sizeF = graphics.MeasureString(s1 & s2, new Font("宋体", defFontSize))
width = width - sizeF.width

For i = defFontSize*2 To 1 Step -1
sizeF = graphics.MeasureString(s3, new Font("宋体", i/2))
If sizeF.width <= width Then
chr= Rg.Characters(s1.length + s2.length + 1,s3.length)
chr.font.size = i/2
Dim sizeF0 = graphics.MeasureString(s0, new Font("宋体", defFontSize))
Dim sizeF1 = graphics.MeasureString(s1, new Font("宋体", defFontSize))
Dim sizeF2 = graphics.MeasureString(s2, new Font("宋体", defFontSize))
Dim j As Integer = 1
Do While 11*j-3*sizeF0.width + sizeF1.width + sizeF2.width + sizeF.width <= rg.width * 4 / 3
j += 1
Loop
rg.value = s1.PadRight(s1.Length+j) & s2 & s3
chr= Rg.Characters(s1.length + s2.length + j + 1,s3.length)
chr.font.size = i/2
Exit For
End If
Next
wb.save
App.visible = True

--  作者：东坡一剑
--  发布时间：2013/10/17 23:10:00
--
我刚才测试7楼的代码，好像还是不行，问题到底出在哪儿呢？

--  作者：东坡一剑
--  发布时间：2013/10/17 23:14:00
--

分享个小技巧

像这种不断变更值得长度进行测试我把" \'做成一个整体考虑，每次剪切它贴到相应的位置就可以，很快。

--  作者：东坡一剑
--  发布时间：2013/10/18 0:28:00
--

神啊，难道当真无解!!!!

难道是graphics.MeasureString测量不准造成的？？？

关键是搞不定居然还没人知道是什么原因，狐坛无人了？？？

我不信，继续期待中……………………