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
加好友 
发短信
Post By：2013/10/17 16:38:00 [只看该作者]
