POI以SAX解析excel2007檔案，完美解決空單元格問題
阿新 • • 發佈：2022-06-01
- 三分式有後三分式和前分式，後三分式多一些，如下：
系統標註的顯示效果：該標註格式為三分是標註，其中分子為圖斑的地類程式碼，中間為分隔線+圖斑的面積，分母為圖斑的地類名稱。實現該樣式標註的詳細VBscript程式碼如下：
點選檢視程式碼
FUNCTION strlen(str) dim p_len p_len=0 strlen=0 p_len=len(str) FOR xx=1 to p_len IF asc(mid(str,xx,1))<0 then strlen=int(strlen) + 2 ELSE strlen=int(strlen) + 1 END if NEXT END function FUNCTION myFind(cunname,DJH,SHAPE_Area ) dim str str=SHAPE_Area dim d d=strlen(str) dim d1 dim d2 d1=strlen(cunname) /2 d2=strlen(DJH) /2 if d2>d1 then d1=d2 end if myFind = cunname & space(d) &vbnewline & string(d1,"—") & str& vbnewline & DJH & space(d) END Function Function FindLabel([DLBM],[DLMC],[shape_area] ) FindLabel = myFind([DLBM],[DLMC],Round([shape_area]*3/2000,1) &"畝" ) End Function
修改FindLabel函式引數，可以是三個，也可以是更多引數；如該函式的標註處理效果，使得字型間隔不符合使用要求的，還需要設定標註字元的間距，具體操作如圖所示。
在該圖層的屬性介面的“標註”選項中，單擊“符號”按鈕，出現如圖所示：
圖7-107 編輯字型符號
單擊“編輯符號”，切換到格式化文字，設定字元間距和行距，都設定為負值，根據效果設定，如圖所示。
設定字型間距和行間距
- 前三分式，效果如下：
點選檢視程式碼
FUNCTION strlen(str) dim p_len p_len=0 strlen=0 p_len=len(str) FOR xx=1 to p_len IF asc(mid(str,xx,1))<0 then strlen=int(strlen) + 2 ELSE strlen=int(strlen) + 1 END if NEXT END function FUNCTION myFind( cunname, DJH,SHAPE_Area ) dim str str=SHAPE_Area dim d d=strlen(str) dim d1 dim d2 d1=strlen(cunname) /2 d2=strlen(DJH) /2 if d2>d1 then d1=d2 end if myFind =" " & space(d-1) &cunname & vbnewline & str & string(d1, "—") & vbnewline & space(d) & DJH END Function Function FindLabel ([小班號],[林種],[樹種],[小班面積],[完成面積],[密度],[完成情況]) FindLabel = myFind( [林種] & "-" & [小班面積] & "（" & [完成面積] & "）",[樹種] & "-" & [密度] & "-" & [完成情況], [小班號]) End Function
設定和上面一樣
- 四分式，效果如下：
點選檢視程式碼
FUNCTION strlen(str) dim p_len p_len=0 strlen=0 p_len=len(str) FOR xx=1 to p_len IF asc(mid(str,xx,1))<0 then strlen=int(strlen) + 2 ELSE strlen=int(strlen) + 1 END if NEXT END function FUNCTION myFind( cunname, DJH,SHAPE_Area,lb ) dim str str=SHAPE_Area dim d d=strlen(str) dim d1 dim d2 d1=strlen(cunname) /2 d2=strlen(DJH) /2 if d2>d1 then d1=d2 end if myFind =" " & space(d-1) &cunname & vbnewline & str & string(d1, "—") & lb & vbnewline & space(d) & DJH END Function Function FindLabel ([小班號],[林種],[樹種],[小班面積],[完成面積],[密度],[完成情況],[類別] ) FindLabel = myFind( [林種] & "-" & [小班面積] & "（" & [完成面積] & "）",[樹種] & "-" & [密度] & "-" & [完成情況], [小班號],[類別]) End Function
- 上下標同時，效果如下
點選檢視程式碼
Function FindLabel ( [NAME] )
Dim lLen
lLen=StrLen( [NAME] )/2
Dim i
Dim sStr
sStr=""
i=0
Do While i<lLen * 2
sStr=sStr & " "
i=i+1
Loop
FindLabel = [NAME] & "<SUP>" & "上面" & vbcrlf & sStr & "下面" & "</SUP>"
End Function
function strlen(str)
dim p_len
p_len=0
strlen=0
p_len=len(str)
for xx=1 to p_len
if asc(mid(str,xx,1))<0 then
strlen=int(strlen) + 2
else
strlen=int(strlen) + 1
end if
next
end function