Free版 Office calc Basic セルの値を取得しTextBoxへセットする


年賀状の印刷を想定しています

あて先リストの行データを取得して、ハガキレイアウトの郵便番号Boxとあて先Boxにセットする関数です



''//------------------------------------------------------------------
sub setAdrs(row)
	Dim oDrawPages As Object
	Dim oDrawPage As Object
	dim sh as Object
	Dim adrsStr1 as string
	Dim adrsStr2 as string
	Dim regStr as string
	Dim adrsStrP1 as string
	Dim adrsStrP2 as string

	dim arrMatch()
	Dim i as Integer
	
	regStr = "(...??[都道府県])((?:旭川|伊達|石狩|盛岡|奥州|田村|南相馬|那須塩原|東村山|武蔵村山|羽村|十日町|上越|富山|野々市|大町|蒲郡|四日市|姫路|大和郡山|廿日市|下松|岩国|田川|大村)市|.+?郡(?:玉村|大町|.+?)[町村]|.+?市.+?区|.+?[市区町村])(.+)"
	
	sh=ThisComponent.Sheets.getByName("Sheet1")
	adrsStr1=sh.getCellByPosition(7,row).String
	adrsStr2=sh.getCellByPosition(8,row).String
	matchexp(adrsStr1,regStr,arrMatch)
	adrsStrP1=""
	adrsStrP2=""
	for i=2 to ubound(arrMatch)
		if i<=3 then
			adrsStrP1=adrsStrP1 & arrMatch(i)
		else
			adrsStrP2=adrsStrP2 & arrMatch(i)
		endif
	
	
	next
	
	sh=ThisComponent.Sheets.getByName("Sheet3")
	oDrawPages = sh.DrawPage


	getTextShapeByName(oDrawPage,oDrawPages,"adrs1")
	oDrawPage.String=adrsStrP1
	
	getTextShapeByName(oDrawPage,oDrawPages,"adrs2")
	oDrawPage.String=adrsStrP2
	
	getTextShapeByName(oDrawPage,oDrawPages,"adrs3")
	oDrawPage.String=adrsStr2
	
end sub

''//------------------------------------------------------------------
sub setZip(row)
	Dim oDrawPages As Object
	Dim oDrawPage As Object
	dim sh as Object
	Dim zipstr as string
	
	sh=ThisComponent.Sheets.getByName("Sheet1")
	zipstr=sh.getCellByPosition(6,row).String
	
	sh=ThisComponent.Sheets.getByName("Sheet3")
	oDrawPages = sh.DrawPage

	getTextShapeByName(oDrawPage,oDrawPages,"zip1")
	oDrawPage.String=mid(zipstr,1,1)
	
	getTextShapeByName(oDrawPage,oDrawPages,"zip2")
	oDrawPage.String=mid(zipstr,2,1)
	getTextShapeByName(oDrawPage,oDrawPages,"zip3")
	oDrawPage.String=mid(zipstr,3,1)
	getTextShapeByName(oDrawPage,oDrawPages,"zip4")
	oDrawPage.String=mid(zipstr,4,1)
	getTextShapeByName(oDrawPage,oDrawPages,"zip5")
	oDrawPage.String=mid(zipstr,5,1)
	getTextShapeByName(oDrawPage,oDrawPages,"zip6")
	oDrawPage.String=mid(zipstr,6,1)
	getTextShapeByName(oDrawPage,oDrawPages,"zip7")
	oDrawPage.String=mid(zipstr,7,1)
	

end sub
''//------------------------------------------------------------------
''// サブ関数
''//------------------------------------------------------------------
Sub getTextShapeByName(TextShape as object,arrTextShape as object,cName as String)
Dim i as Integer

For i = 0 To arrTextShape.Count - 1
	If arrTextShape.GetbyIndex(i).Name=cName Then
    	TextShape =  arrTextShape.GetbyIndex(i)
    	Exit Sub
  	End If
Next i

end sub


Function matchexp(src as string,searchstr as string,arrMatch  ) as Integer

	Dim oTextSearch as Object
	Dim oOption as Object
	Dim searchStart as Integer
	dim i as integer
	ReDim Preserve  arrMatch(0)
	
	arrMatch(0)=src
	oTextSearch = CreateUnoService("com.sun.star.util.TextSearch")
	oOption = CreateUnoStruct("com.sun.star.util.SearchOptions")

	oOption.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
	oOption.searchFlag = com.sun.star.util.SearchFlags.REG_EXTENDED
	oOption.searchString = searchstr

	oTextSearch.setOptions(oOption)

	searchStart=0
	do while  searchStart < Len(src)
		oResult = oTextSearch.searchForward(src,searchStart,Len(src))
  		If oResult.subRegExpressions = 1 Then
  			searchStart = oResult.endOffset(0) 		
			
			ReDim Preserve  arrMatch(UBound( arrMatch )+1)
			
			arrMatch(UBound(arrMatch))=mid(src,oResult.startOffset(0) +1,oResult.EndOffset(0) -oResult.startOffset(0))
		elseif oResult.subRegExpressions > 1 Then
			for i=0 to ubound(oResult.startOffset)
				ReDim Preserve  arrMatch(UBound( arrMatch )+1)
				arrMatch(UBound(arrMatch))=mid(src,oResult.startOffset(i) +1,oResult.EndOffset(i) -oResult.startOffset(i))
			
			next		
			searchStart=Len(src)
    	else
			searchStart=Len(src)
  		End If
	
	loop

	matchexp=ubound(arrMatch)


end function

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です