Calc crashes after end Basic script

[ANteC]

Hello.
I have problem with OOo & my Basic script - OOo Calc crashes after script end.
Is there oportunity view why Calc crashes?

PS my script read some info from current sheet and writ it to template.xls (i also try use odt - nothing change)

If you need i can upload script and 2 xls files.

Thanks

[ANteC]

Also if Basic script save and close template.xls (DocTemplate.close(true)) Calc work fine without crashes.

[Hagar Delest]

I think we need to see your script. use the BBCode tags for code.
NB: I don't have any skills in scripts so I won't be of any help I think but others may spot what's the problem if they see the code.

[ANteC]

Code: Select all

Option Explicit
Dim DocTemplate as Object
Dim DocSource as Object
Dim SheetTemplate as Object
Dim SheetSource as Object
Dim Position as integer
Dim PositionMax as integer
Dim CharWeight As INTEGER
Dim IGENumber As byte

Dim ValGrunt(2,0) as double
Dim GalGrunt(2,0) as double
Dim GravGrunt(2,0) as double
Dim GravSand(2,0) as double
Dim BigSand(2,0) as double
Dim MiddleSand(2,0) as double
Dim SmallSand(2,0) as double
Dim DustSand(2,0) as double
Dim Supes(2,0) as double
Dim Suglinok(2,0) as double
Dim Glina(2,0) as double
Dim Corrosian (2,0) as double
Dim CorrosianCheck	as Boolean


Function RoundEx( dVal As Double, Optional iPrecision As Integer) As Double 
       dim iPrec as integer 
       Dim roundStr As String 
       Dim WholeNumberPart As String 
       Dim DecimalPart As String 
       Dim i As Integer 
       Dim RoundUpValue As Double 
       
       
       roundStr = CStr(dVal) 
       
       if isMissing( iPrecision ) then 
         iPrec = 0 
       else 
         iPrec = iPrecision 
       endif 
        
       If InStr(1, roundStr, ",") = 0 Then 
           RoundEx = dVal 
           Exit Function 
       End If 
       WholeNumberPart = Mid(roundStr, 1, InStr(1, roundStr, ",") - 1) 
       DecimalPart = Mid(roundStr, InStr(1, roundStr, ","), Len(roundStr))
       If Len(DecimalPart) > iPrec + 1 Then 
           Select Case Mid(DecimalPart, iPrec + 2, 1)
               Case "0", "1", "2", "3", "4" 
                   DecimalPart = Mid(DecimalPart, 1, iPrec + 1) 
               Case "5", "6", "7", "8", "9" 
                   RoundUpValue = 0.1 
                   For i = 1 To iPrec - 1 
                       RoundUpValue = RoundUpValue * 0.1 
                   Next 
                   DecimalPart = CStr(cdbl(Mid(DecimalPart, 1, iPrec + 1)) + RoundUpValue) 
                   If Mid(DecimalPart, 1, 1) <> "1" Then 
                       DecimalPart = Mid(DecimalPart, 1) 
                   Else 
                       WholeNumberPart = CStr(cDbl(WholeNumberPart) + 1) 
                       DecimalPart = "" 
                   End If 
           End Select 
       End If 
       RoundEx = cDbl(WholeNumberPart & DecimalPart) 

End Function

Private Sub FormatCell(x as Object)
Dim LocalSettings As New com.sun.star.lang.Locale
Dim NumberFormats As Object
Dim NumberFormatId As Long
Dim NumberFormatString AS String

 LocalSettings.Language = "en"
 LocalSettings.Country = "en"
 NumberFormats = DocSource.NumberFormats
 NumberFormatString = "#"
 NumberFormatId = NumberFormats.queryKey(NumberFormatString, LocalSettings, True)
 If NumberFormatId = -1 Then
 	NumberFormatId = NumberFormats.addNew(NumberFormatString, LocalSettings)
 End If
 x.NumberFormat = NumberFormatId
end Sub

Private Function AbsolAddress (x, y As INTEGER) 
  Dim nb As double
  Dim i As integer
  Dim AdrStr As String 
  AdrStr="" 
  nb= (x+1) / 26
  'if nb >= 1 then 
	  For i=1 to nb
	    AdrStr = AdrStr+"A" 
	  next i
  'end if
  AdrStr = AdrStr+Chr((x mod 26)+65) 
  AdrStr = AdrStr+Cstr(y+1) 
  AbsolAddress=AdrStr  
End Function


Private Sub Fill(Arg() as double, Pos as integer)
Dim ii as integer
Dim nn as integer
Dim mm as integer
Dim ff as integer
Dim a as string
Dim aLineBorder As New com.sun.star.table.BorderLine
Dim RoundNumber as integer
dim test as string


CharWeight = 150

SheetTemplate.getCellRangeByPosition( 0, Pos-1, 46, Pos-1 ).merge(true)
SheetTemplate.getCellRangeByPosition( 0, Pos-2, 46, Pos-2 ).merge(true)
SheetTemplate.getCellRangeByPosition( 0, Pos, 46, Pos ).LeftBorder    = MakeCellBorderLine( 0, 0, 0, 0 )
SheetTemplate.getCellRangeByPosition( 0, Pos, 46, Pos ).RightBorder   = MakeCellBorderLine( 0, 0, 0, 0 )
SheetTemplate.getCellRangeByPosition( 0, Pos, 46, Pos ).TopBorder     = MakeCellBorderLine( 0, 0, 0, 0 )
SheetTemplate.getCellRangeByPosition( 0, Pos, 46, Pos ).BottomBorder  = MakeCellBorderLine( 0, 0, 0, 0 ) 

For ii = 1 to UBound (Arg,2)
	SheetTemplate.getCellByPosition(0, ii + Pos).string = ii	
	For nn = 0 to 42
	
		Select Case nn
			Case 0 To 13, 35
			RoundNumber = 1
			Case 14 To 24, 33, 36 To 41
			RoundNumber = 2
			Case 25 To 32
			RoundNumber = 3
		End Select
	
		if nn <> 2 and nn <> 34 then
			if InStr(SheetSource.getCellByPosition(nn, Arg(0,ii)).string, "#") = 0 and SheetSource.getCellByPosition(nn, Arg(0,ii)).string <> "" then 
				test = SheetSource.getCellByPosition(nn, Arg(0,ii)).string
				SheetTemplate.getCellByPosition(1 + nn, ii + Pos).value = RoundEx (CDbl(SheetSource.getCellByPosition(nn, Arg(0,ii)).string),RoundNumber)
				if SheetTemplate.getCellByPosition(1 + nn, ii + Pos).value = 0 then FormatCell SheetTemplate.getCellByPosition(1 + nn, ii + Pos)
			end if
		else
			SheetTemplate.getCellByPosition(1 + nn, ii + Pos).string = SheetSource.getCellByPosition(nn, Arg(0,ii)).string
		end if
	next nn
next ii

if CorrosianCheck = False then
	SheetTemplate.getCellRangeByPosition( 0, ii + Pos, 3, ii+ Pos ).merge(true)
	SheetTemplate.getCellByPosition(0, ii + Pos).string = "среднее"
	SheetTemplate.getCellByPosition(0, ii + Pos).charWeight = 150
	
	For mm = 1 to 33
		Select Case mm
			Case 0 To 13, 35
			RoundNumber = 1
			Case 14 To 24, 33, 36 To 41
			RoundNumber = 2
			Case 25 To 32
			RoundNumber = 3
		End Select
			
		if mm <> 12 and mm <> 13 and mm <> 14 and mm <> 18 and mm <> 19 and mm <> 20 and mm <> 21 and mm <> 31 and mm <> 32 then
			For ff = 1 to ii - 1
				if SheetTemplate.getCellByPosition(4 + mm, ff + Pos).string <> "" then
				SheetTemplate.getCellByPosition(4 + mm, ii + Pos).formula =  "=ROUND(AVERAGE(" + AbsolAddress(4 + mm,Pos + 1) & ":" & AbsolAddress(4 + mm,Pos + ii - 1) + ");" & RoundNumber &")"
				SheetTemplate.getCellByPosition(4 + mm, ii + Pos).charWeight = 150
				Exit For
				end if 
			next ff
		end if
		
		Select Case mm
		case 13
		SheetTemplate.getCellByPosition(4 + mm, ii + Pos).formula = "=ROUND(" + AbsolAddress(3 + mm,Pos + ii) + "/(1 + " + AbsolAddress(6 + mm,Pos + ii) & "); 2)"
		SheetTemplate.getCellByPosition(4 + mm, ii + Pos).charWeight = 150
		case 14
		SheetTemplate.getCellByPosition(4 + mm, ii + Pos).formula = "=ROUND((" + AbsolAddress(1 + mm,Pos + ii) + " - " + AbsolAddress(3 + mm,Pos + ii) & ")/" + AbsolAddress(3 + mm,Pos + ii) & "; 2)"
		SheetTemplate.getCellByPosition(4 + mm, ii + Pos).charWeight = 150
		case 18
		if SheetTemplate.getCellByPosition(2 + mm,Pos + ii).string <> "" and SheetTemplate.getCellByPosition(3 + mm,Pos + ii).string <> "" then
			SheetTemplate.getCellByPosition(4 + mm, ii + Pos).formula = "=ROUND(" + AbsolAddress(2 + mm,Pos + ii) + "-" + AbsolAddress(3 + mm,Pos + ii) & "; 2)"
			SheetTemplate.getCellByPosition(4 + mm, ii + Pos).charWeight = 150
		end if
		case 19
		if SheetTemplate.getCellByPosition(mm,Pos + ii).string <> "" and SheetTemplate.getCellByPosition(2 + mm,Pos + ii).string  <> "" _
				and SheetTemplate.getCellByPosition(1 + mm,Pos + ii).string <> "" or SheetTemplate.getCellByPosition(1 + mm,Pos + ii).value <> 0 then
					SheetTemplate.getCellByPosition(4 + mm, ii + Pos).formula = "=ROUND((" + AbsolAddress(mm,Pos + ii) + "-" + AbsolAddress(2 + mm,Pos + ii) + ")/" + AbsolAddress(1 + mm,Pos + ii) & "; 2)"
					SheetTemplate.getCellByPosition(4 + mm, ii + Pos).charWeight = 150
		end if
		case 20
		if SheetTemplate.getCellByPosition(mm - 2,Pos + ii).string <> "" and SheetTemplate.getCellByPosition(mm - 5,Pos + ii).string <> "" _
				and SheetTemplate.getCellByPosition(mm - 5,Pos + ii).value <> 0 then
			SheetTemplate.getCellByPosition(4 + mm, ii + Pos).formula = "=ROUND(" + AbsolAddress(mm - 2,Pos + ii) + "/" + AbsolAddress(mm - 5,Pos + ii) & "; 2)"
			SheetTemplate.getCellByPosition(4 + mm, ii + Pos).charWeight = 150
		end if
		case 21
		if SheetTemplate.getCellByPosition(mm - 2,Pos + ii).string <> "" and SheetTemplate.getCellByPosition(mm - 5,Pos + ii).string <> "" _
				and SheetTemplate.getCellByPosition(mm - 3,Pos + ii).string <> "" and SheetTemplate.getCellByPosition(mm - 3,Pos + ii).value <> 0 then
		'MsgBox (SheetSource.getCellByPosition(mm - 3,Pos + ii).value)
		SheetTemplate.getCellByPosition(4 + mm, ii + Pos).formula = "=ROUND(" + AbsolAddress(mm - 2,Pos + ii) + "*" + AbsolAddress(mm - 5,Pos + ii) + ")/" + AbsolAddress(mm - 3,Pos + ii) & "; 2)"
		SheetTemplate.getCellByPosition(4 + mm, ii + Pos).charWeight = 150
		end if
		end Select
		if SheetTemplate.getCellByPosition(4 + mm, ii + Pos).value = 0 then FormatCell SheetTemplate.getCellByPosition(4 + mm, ii + Pos)
	next mm
	
	if Position > PositionMax then PositionMax = Position + ii
End if
End Sub


Private Function FPosition(X() as double)
Position = 11
IGENumber = 2

if ValGrunt(2,0) <> 0 and X(2,0) > ValGrunt(2,0) then
Position = Position + Ubound (ValGrunt,2) + 4
IGENumber = IGENumber +1
end if

if GalGrunt(2,0) <> 0 and X(2,0) > GalGrunt(2,0) then
Position = Position + Ubound (GalGrunt,2) + 4
IGENumber = IGENumber +1
end if

if GravGrunt(2,0) <> 0 and X(2,0) > GravGrunt(2,0) then
Position = Position + Ubound (GravGrunt,2) + 4
IGENumber = IGENumber +1
end if

if GravSand(2,0) <> 0 and X(2,0) > GravSand(2,0) then
Position = Position + Ubound (GravSand,2) + 4
IGENumber = IGENumber +1
end if

if BigSand(2,0) <> 0 and X(2,0) > BigSand(2,0) then
Position = Position + Ubound (BigSand,2) + 4
IGENumber = IGENumber +1
end if

if MiddleSand(2,0) <> 0 and X(2,0) > MiddleSand(2,0) then
Position = Position + Ubound (MiddleSand,2) + 4
IGENumber = IGENumber +1
end if

if SmallSand(2,0) <> 0 and X(2,0) > SmallSand(2,0) then
Position = Position + Ubound (SmallSand,2) + 4
IGENumber = IGENumber +1
end if

if DustSand(2,0) <> 0 and X(2,0) > DustSand(2,0) then
Position = Position + Ubound (DustSand,2) + 4
IGENumber = IGENumber +1
end if

if Supes(2,0) <> 0 and X(2,0) > Supes(2,0) then
Position = Position + Ubound (Supes,2) + 4
IGENumber = IGENumber +1
end if

if Suglinok(2,0) <> 0 and X(2,0) > Suglinok(2,0) then
Position = Position + Ubound (Suglinok,2) + 4
IGENumber = IGENumber +1
end if

if Glina(2,0) <> 0 and X(2,0) > Glina(2,0) then
Position = Position + Ubound (Glina,2) + 4
IGENumber = IGENumber +1
end if

End Function


Private Function SortByLabNumber(Param() as double)
dim ii as integer
dim jj as integer
dim x0 as double
dim x1 as double
dim x2 as double

Param(2,0) = Param(2,1)
for jj = 1 to Ubound(Param,2) - 1 
	For ii = 1 to Ubound(Param,2) - 1
		if Param(1,ii) > Param(1,ii+1) then
			x0 = Param(0,ii):x1 = Param(1,ii):x2=Param(2,ii)
			Param(0,ii) = Param(0,ii+1):Param(1,ii) = Param(1,ii+1):Param(2,ii) = Param(2,ii+1)
			Param(0,ii+1) = x0:Param(1,ii+1) = x1:Param(2,ii+1) = x2
		end if
		if Param(2,ii+1) < Param(2,0) and Param(2,ii+1) <> 0 then Param(2,0) = Param(2,ii+1)
	next ii
next jj
End function

Private Function MakeCellBorderLine( nColor, nInnerLineWidth, nOuterLineWidth, nLineDistance ) As com.sun.star.table.BorderLine 
Dim oBorderLine as Variant
   oBorderLine = createUnoStruct( "com.sun.star.table.BorderLine" ) 
   With oBorderLine 
      .Color = nColor 

      .InnerLineWidth = nInnerLineWidth 
      .OuterLineWidth = nOuterLineWidth 
      .LineDistance = nLineDistance 
   End With 
   MakeCellBorderLine = oBorderLine 
End Function

Sub Schitalko
Dim i as integer
Dim n as integer
Dim Url as string
Dim FileProperties(0) As New com.sun.star.beans.PropertyValue
Dim oPrintArea (0) as New com.sun.star.table.CellRangeAddress

Dim CurrentPrim as string
Dim CurrentDepth as string
Dim CurrentLabNumber as string
Dim CorrosionBoolean as Boolean
Dim DeltaCell as integer
Dim CurrentPath as string
Dim Dummy()

CurrentPath = ConvertToUrl(CurDir & "\Физ мех.xls")

CorrosianCheck = False
DeltaCell = 58
IGENumber = 1
CorrosionBoolean = False
FileProperties(0).Name = "AsTemplate"
FileProperties(0).Value ="False"
Url = "file:///C:/Program Files/Common Files/Template_OOo/Template.xls"

DocSource = ThisComponent
SheetSource =  DocSource.getCurrentController.getActiveSheet 'DocSource.Sheets.GetByName("Физ_ мех_ свойства")
DocTemplate = StarDesktop.loadComponentFromURL(Url, "_blank", 0, FileProperties())
SheetTemplate = DocTemplate.Sheets.GetByName("Физ_мех")

SheetTemplate.getCellRangeByPosition( 0, 0, 44, 1500 ).HoriJustify = com.sun.star.table.CellHoriJustify.CENTER
SheetTemplate.getCellRangeByPosition( 0, 0, 44, 1500 ).VertJustify = com.sun.star.table.CellVertJustify.CENTER
SheetTemplate.getCellByPosition(0, 1).string = SheetSource.getCellByPosition(0, 1).string

if SheetSource.getCellByPosition(0, 2).string <> "Лабораторный №" _
			or SheetSource.getCellByPosition(2, 2).string <> "Глубина взятия образца" _
				or SheetSource.getCellByPosition(43, 2).string <> "Примечание" then
				MsgBox("Шаблон был изменен! Дальнейшая работа невозможна!")
				DocTemplate.close(true)
				Exit Sub
end if

SheetTemplate.getCellByPosition(0, 1).string = SheetSource.getCellByPosition(0, 1).string

for i = 10 to 1500
	if LCase(SheetSource.getCellByPosition(0,i).string) = "коррозия" then CorrosionBoolean = True
	
	if CorrosionBoolean = False then
		CurrentPrim = LCase(SheetSource.getCellByPosition(43,i).string)
		CurrentDepth = SheetSource.getCellByPosition(2,i).string
		CurrentLabNumber = SheetSource.getCellByPosition(0,i).string
		if InStr(CurrentDepth,"-") <> 0 then
			CurrentDepth = Left(CurrentDepth,InStr(CurrentDepth,"-")-1)
		end if
		CurrentDepth = Trim(CurrentDepth)
		
		
		if InStr(CurrentPrim,"грунт") <> 0 then
			if InStr(CurrentPrim,"вал") <> 0 then
				n = UBound (ValGrunt, 2) + 1
				Redim Preserve ValGrunt(2,n)
				ValGrunt(0,n) = i
				ValGrunt(1,n) = CurrentLabNumber
				ValGrunt(2,n) = CDbl(CurrentDepth)
			end if
	
			if InStr(CurrentPrim,"гал") <> 0 then
				n = UBound (GalGrunt, 2) + 1
				Redim Preserve GalGrunt(2,n)
				GalGrunt(0,n) = i
				GalGrunt(1,n) = CurrentLabNumber
				GalGrunt(2,n) = CDbl(CurrentDepth)
			end if
	
			if InStr(CurrentPrim,"грав") <> 0 then
				n = UBound (GravGrunt, 2) + 1
				Redim Preserve GravGrunt(2,n)
				GravGrunt(0,n) = i
				GravGrunt(1,n) = CurrentLabNumber
				GravGrunt(2,n) = CDbl(CurrentDepth)
			end if				
		end if 
		
		if InStr(CurrentPrim,"песок") <> 0 or InStr(CurrentPrim,"пес.") <> 0 then
			
			if InStr(CurrentPrim,"грав") <> 0 then
				n = UBound (GravSand, 2) + 1
				Redim Preserve GravSand(2,n)
				GravSand(0,n) = i
				GravSand(1,n) = CurrentLabNumber
				GravSand(2,n) = CDbl(CurrentDepth)
			end if
			
			if InStr(CurrentPrim,"сред") <> 0 or InStr(CurrentPrim,"ср.") <> 0 then
			n = UBound (MiddleSand, 2) + 1
			Redim Preserve MiddleSand(2,n)
			MiddleSand(0,n) = i
			MiddleSand(1,n) = CurrentLabNumber
			MiddleSand(2,n) = CDbl(CurrentDepth)
	
			else
				if InStr(CurrentPrim,"кр") <> 0 then
					n = UBound (BigSand, 2) + 1
					Redim Preserve BigSand(2,n)
					BigSand(0,n) = i
					BigSand(1,n) = CurrentLabNumber
					BigSand(2,n) = CDbl(CurrentDepth)
				end if
			end if
			
			if InStr(CurrentPrim,"мел") <> 0 then
				n = UBound (SmallSand, 2) + 1
				Redim Preserve SmallSand(2,n)
				SmallSand(0,n) = i
				SmallSand(1,n) = CurrentLabNumber
				SmallSand(2,n) = CDbl(CurrentDepth)
			end if
	
			if InStr(CurrentPrim,"пыл") <> 0 then
				n = UBound (DustSand, 2) + 1
				Redim Preserve DustSand(2,n)
				DustSand(0,n) = i
				DustSand(1,n) = CurrentLabNumber
				DustSand(2,n) = CDbl(CurrentDepth)
			end if
			
		end if
	
		if InStr(CurrentPrim,"суп") <> 0 then
			n = UBound (Supes, 2) + 1
			Redim Preserve Supes(2,n)
			Supes(0,n) = i
			Supes(1,n) = CurrentLabNumber
			Supes(2,n) = CDbl(CurrentDepth)
		end if
	
		if InStr(CurrentPrim,"сугл") <> 0 then
			n = UBound (Suglinok, 2) + 1
			Redim Preserve Suglinok(2,n)
			Suglinok(0,n) = i
			Suglinok(1,n) = CurrentLabNumber
			Suglinok(2,n) = CDbl(CurrentDepth)
		end if
		
		if InStr(CurrentPrim,"глина") <> 0 then
			n = UBound (Glina, 2) + 1
			Redim Preserve Glina(2,n)
			Glina(0,n) = i
			Glina(1,n) = CurrentLabNumber
			Glina(2,n) = CDbl(CurrentDepth)
		end if
	else 'CorrosianBoolean = True
		if UBound (Corrosian, 2) = 0 then i = i + 1
		if SheetSource.getCellByPosition(0,i).string <> "" then
			n = UBound (Corrosian, 2) + 1
			Redim Preserve Corrosian(2,n)
			Corrosian(0,n) = i
			Corrosian(1,n) = SheetSource.getCellByPosition(0,i).value
			Corrosian(2,n) = CDbl(SheetSource.getCellByPosition(1,i).value)
		end if
	end if
	
next i

if Ubound(ValGrunt,2) > 0 then SortByLabNumber ValGrunt
if Ubound(GalGrunt,2) > 0 then SortByLabNumber GalGrunt
if Ubound(GravGrunt,2) > 0 then SortByLabNumber GravGrunt
if Ubound(GravSand,2) > 0 then SortByLabNumber GravSand
if Ubound(BigSand,2) > 0 then SortByLabNumber BigSand
if Ubound(MiddleSand,2) > 0 then SortByLabNumber MiddleSand
if Ubound(SmallSand,2) > 0 then SortByLabNumber SmallSand
if Ubound(DustSand,2) > 0 then SortByLabNumber DustSand
if Ubound(Supes,2) > 0 then SortByLabNumber Supes
if Ubound(Suglinok,2) > 0 then SortByLabNumber Suglinok
if Ubound(Glina,2) > 0 then SortByLabNumber Glina
if Ubound(Corrosian,2) > 0 then SortByLabNumber Corrosian


if Ubound(ValGrunt,2) > 0 then
	FPosition ValGrunt
	SheetTemplate.getCellByPosition(0,Position - 1).string = "Валунный грунт - ИГЭ " + IGENumber
	SheetTemplate.getCellByPosition(0, Position - 1).charWeight = 150
	if DeltaCell > 58 - Position then DeltaCell = 58 - Position
	Fill ValGrunt, Position
end if

if Ubound(GalGrunt,2) > 0 then 
	FPosition GalGrunt
	SheetTemplate.getCellByPosition(0,Position - 1).string = "Галечниковый грунт - ИГЭ " + IGENumber
	SheetTemplate.getCellByPosition(0, Position - 1).charWeight = 150
	if DeltaCell > 58 - Position then DeltaCell = 58 - Position
	Fill GalGrunt, Position
end if

if Ubound(GravGrunt,2) > 0 then 
	FPosition GravGrunt
	SheetTemplate.getCellByPosition(0,Position - 1).string = "Гравийный грунт - ИГЭ " + IGENumber
	SheetTemplate.getCellByPosition(0, Position - 1).charWeight = 150
	if DeltaCell > 58 - Position then DeltaCell = 58 - Position
	Fill GravGrunt, Position
end if

if Ubound(GravSand,2) > 0 then 
	FPosition GravSand
	SheetTemplate.getCellByPosition(0,Position - 1).string = "Песок гравелистый - ИГЭ " + IGENumber
	SheetTemplate.getCellByPosition(0, Position - 1).charWeight = 150
	if DeltaCell > 58 - Position then DeltaCell = 58 - Position
	Fill GravSand, Position
end if

if Ubound(BigSand,2) > 0 then 
	FPosition BigSand
	SheetTemplate.getCellByPosition(0,Position - 1).string = "Песок крупный - ИГЭ " + IGENumber
	SheetTemplate.getCellByPosition(0, Position - 1).charWeight = 150
	if DeltaCell > 58 - Position then DeltaCell = 58 - Position
	Fill BigSand, Position
end if

if Ubound(MiddleSand,2) > 0 then 
	FPosition MiddleSand
	SheetTemplate.getCellByPosition(0,Position - 1).string = "Песок средней крупности - ИГЭ " + IGENumber
	SheetTemplate.getCellByPosition(0, Position - 1).charWeight = 150
	if DeltaCell > 58 - Position then DeltaCell = 58 - Position
	Fill MiddleSand, Position
end if

if Ubound(SmallSand,2) > 0 then 
	FPosition SmallSand
	SheetTemplate.getCellByPosition(0,Position - 1).string = "Песок мелкий - ИГЭ " + IGENumber
	SheetTemplate.getCellByPosition(0, Position - 1).charWeight = 150
	if DeltaCell > 58 - Position then DeltaCell = 58 - Position
	Fill SmallSand, Position
end if

if Ubound(DustSand,2) > 0 then 
	FPosition DustSand
	SheetTemplate.getCellByPosition(0,Position - 1).string = "Песок пылеватый - ИГЭ " + IGENumber
	SheetTemplate.getCellByPosition(0, Position - 1).charWeight = 150
	if DeltaCell > 58 - Position then DeltaCell = 58 - Position
	Fill DustSand, Position
end if

if Ubound(Supes,2) > 0 then 
	FPosition Supes
	SheetTemplate.getCellByPosition(0,Position - 1).string = "Супесь - ИГЭ " + IGENumber
	SheetTemplate.getCellByPosition(0, Position - 1).charWeight = 150
	if DeltaCell > 58 - Position then DeltaCell = 58 - Position
	Fill Supes, Position
end if

if Ubound(Suglinok,2) > 0 then 
	FPosition Suglinok
	SheetTemplate.getCellByPosition(0,Position - 1).string = "Суглинок - ИГЭ " + IGENumber
	SheetTemplate.getCellByPosition(0, Position - 1).charWeight = 150
	if DeltaCell > 58 - Position then DeltaCell = 58 - Position
	Fill Suglinok, Position
end if

if Ubound(Glina,2) > 0 then 
	FPosition Glina
	SheetTemplate.getCellByPosition(0,Position - 1).string = "Глина - ИГЭ " + IGENumber
	SheetTemplate.getCellByPosition(0, Position - 1).charWeight = 150
	if DeltaCell > 58 - Position then DeltaCell = 58 - Position
	Fill Glina, Position
end if

if Ubound(Corrosian,2) > 0 then 
	CorrosianCheck = True
	SheetTemplate.getCellRangeByPosition( 0, PositionMax + 3, 46, PositionMax + 3).merge(true)
	SheetTemplate.getCellByPosition(0,PositionMax + 3).string = "Коррозия"
	SheetTemplate.getCellByPosition(0, PositionMax + 3).charWeight = 150
	Fill Corrosian, PositionMax + 4
end if

For i = 1 to 11
	
next i

oPrintArea (0).Sheet = 0
oPrintArea (0).StartColumn = 0
oPrintArea (0).StartRow = 0
oPrintArea (0).EndColumn = 47
oPrintArea (0).EndRow = 55 - DeltaCell
SheetTemplate.setPrintAreas (oPrintArea ())
SheetTemplate.Rows.insertByIndex(56 - DeltaCell, 1)

For i = 0 to 48
SheetTemplate.getCellByPosition(56 - DeltaCell, i).value = i + 1
next i

DocTemplate.storeAsURL(CurrentPath, Dummy())

DocTemplate.close(true) ' CALC CRASHES IF THIS LINE COMMENTED,  (Crashed after script finished)
End Sub

[B Marcelly]

Hi,
Of course, just a glance on this 593 lines script...

In the routine Schitalko you have an if expression which, if True, closes DocTemplate. But you continue to use your closed document through SheetTemplate, so you are destroying released memory.

Even when DocTemplate is not prematurely closed, you make many modifications on this document but you don't save it before the final close.

______
Bernard

[ANteC]

If you say about

Code: Select all

if SheetSource.getCellByPosition(0, 2).string <> "Лабораторный №" _
         or SheetSource.getCellByPosition(2, 2).string <> "Глубина взятия образца" _
            or SheetSource.getCellByPosition(43, 2).string <> "Примечание" then
            MsgBox("Шаблон был изменен! Дальнейшая работа невозможна!")
            DocTemplate.close(true)
end if

I simple forgot Exit Sub before end if:

Code: Select all

if SheetSource.getCellByPosition(0, 2).string <> "Лабораторный №" _
         or SheetSource.getCellByPosition(2, 2).string <> "Глубина взятия образца" _
            or SheetSource.getCellByPosition(43, 2).string <> "Примечание" then
            MsgBox("Шаблон был изменен! Дальнейшая работа невозможна!")
            DocTemplate.close(true)
            Exit Sub
end if

In this case script must be end.

but you don't save it before the final close

Sorry i made save doctemplate just today.
But If DocTemplate.close(true) work and DocTemplate closed Calc not crashes.
The crashes is if comment final line ('DocTemplate.close(true)).

PS I'm update code script in my previous post

[B Marcelly]

Hi,

You are using CurDir. This Basic instruction is obsolete, could be the source of the problem. Replace it by a real directory name.

This is not the origin of the crash, but there is another error : you are storing DocTemplate with .xls extension, but this is not enough. The document is still stored as an OpenOffice Calc document. To store as a Excel file you must use a property FilterName with a value like "MS Excel 97".

To narrow on your bug there is only one method : simplify code, simplify code, simplify code.
In your case, this means : load your template, change nothing, store to an explicit location, close.
Perhaps the problem is in your template.

Important to know also : which OpenOffice version are you using ? Are there VBA macros in the Excel template ?

[ANteC]

You are using CurDir. This Basic instruction is obsolete, could be the source of the problem. Replace it by a real directory name.

Without CurDir Calc Crashes too.

To store as a Excel file you must use a property FilterName with a value like "MS Excel 97".

Thnx for remark, i'm will done it, but Template save as xls (because in OOo options set save electron table as MS Office)

Important to know also : which OpenOffice version are you using ? Are there VBA macros in the Excel template ?

I use OOo 2.4 in Russian assembly by Infra-Resurs.
Template has not any VBA macros.

To narrow on your bug there is only one method : simplify code, simplify code, simplify code.

Thnx for advice

[ANteC]

I has defined in which functions causes Calc crashes (use breackpoints).
The function is FormatCell. After executing this function OOo crashed:

Code: Select all

Private Sub FormatCell(x as Object)
Dim LocalSettings As New com.sun.star.lang.Locale
Dim NumberFormats As Object
Dim NumberFormatId As Long
Dim NumberFormatString AS String

 LocalSettings.Language = "en"
 LocalSettings.Country = "us"
 NumberFormats = DocSource.NumberFormats
 NumberFormatString = "#"
 NumberFormatId = NumberFormats.queryKey(NumberFormatString, LocalSettings, True)
 If NumberFormatId = -1 Then
 	NumberFormatId = NumberFormats.addNew(NumberFormatString, LocalSettings)
 End If
 x.NumberFormat = NumberFormatId
end Sub

But Why it happend i can't understant. Please help me.

I call this function - FormatCell SheetTemplate.getCellByPosition(4 + mm, ii + Pos)

PS Also i test my script without function FormatCell - all work fine without crashes.

[ANteC]

i solve this trouble:

Code: Select all

Private Sub FormatCell(x as Object)
Dim NumberFormatId As Long

NumberFormatId = 1
x.NumberFormat = NumberFormatId
end Sub

I think that somthing was wrong in LocalSettings.

But there is another trouble - CurDir returns path "C:\Program Files\OpenOffice.org 2.4\program" , but current open file is in "c:\"

[kingfisher]

Evidently, that function is obsolete. That may be why it does not work. There are some functions in the provided macro folders; IIRC, you'll find them in the 'Tools' folder.