hva er galt med denne koden

[visualmaniac]

Private Sub UIButtonControl1_Click()

 

Dim pMxDoc As IMxDocument

Set pMxDoc = ThisDocument

 

Dim pUID As New UID

pUID = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}" 'IGeoFeatureLayer IID

 

Dim pEnumLayer As IEnumLayer

 

Dim pFeatureLayer As IFeatureLayer

Dim pFeatureClass As IFeatureClass

Dim pFeatureCursor As IFeatureCursor

Dim pFeature As IFeature

Dim pPointCollection As IPointCollection

 

Dim pPolygon As IPolygon

 

 

 

'Varibler for koordinat-beregning

Dim pytlengde As Double

Dim pX1 As Double

Dim py1 As Double

Dim pZ1 As Double

Dim pX2 As Double

Dim py2 As Double

Dim pZ2 As Double

Dim ds As Double

 

 

End Sub

 

'--------Klargjøring av Word-fil for skriving:--------------------

Sub WordSkriving()

 

Dim objword As Word.Application

Dim newdoc As Word.Document

Dim table As Word.table

Dim I1 As Long

Dim I3 As Long

 

Dim NormalStyle As String

 

 

NormalStyle = "normal"

 

On Error Resume Next ' Defer error trapping.

Set objword = GetObject(, "Word.Application")

If Err.Number <> 0 Then

 

'MsgBox ("Word er ikke startet, men startes opp når du har klikket OK")

Set objword = CreateObject("Word.Application")

Err.Clear ' Clear Err object in case error occurred.

 

 

Else

'MsgBox ("Word er startet opp allerede. Legger kun til nytt dokument.")

End If

 

'Skrur av feilbehandleren

On Error GoTo 0

 

'Gjør Word-vinduet synlig på skjermen

objword.Visible = True

 

'Lager et nytt dokument i word-objektet

Set newdoc = objword.Documents.Add '(Template:="Sosiv3D.dot")

 

 

'-----klargjøring av Word-fil er ferdig--------------------------

 

Dim dTotalArea As Double

 

Dim i As Long

Dim text As String

 

 

'Klargjør liste av layere i aktivt vindu, setter layer-"peker" til starten på samlingen:

Set pEnumLayer = pMxDoc.FocusMap.Layers(pUID, True)

pEnumLayer.Reset

 

Set pFeatureLayer = pEnumLayer.Next

'Løkke som går gjennom alle layere:

Do Until (pFeatureLayer Is Nothing)

 

MsgBox "Layernavn/Shapetype : " & pFeatureLayer.Name & " / " & pFeatureLayer.FeatureClass.ShapeType

 

If (pFeatureLayer.FeatureClass.ShapeType = esriGeometryPolygon) Then

 

MsgBox "Antall objekter i layeren: " & pFeatureLayer.FeatureClass.FeatureCount(Nothing)

 

'Behandler featureklassen som tilhører layeren (kun en featureklasse pr layer)

Set pFeatureClass = pFeatureLayer.FeatureClass

MsgBox "Antall felt i attributt-tabellen: " & pFeatureClass.Fields.FieldCount

 

 

'Løkke som går gjennom alle fields i featureklassen:

For i = 0 To (pFeatureClass.Fields.FieldCount - 1)

 

MsgBox "Felt (" & i & ") : " & pFeatureClass.Fields.Field(i).Name & _

" / " & pFeatureClass.Fields.Field(i).Type & _

" / " & pFeatureClass.Fields.Field(i).VarType & _

" / " & pFeatureClass.Fields.Field(i).Required & _

vbCr

Next i

 

'Behandler enkelt-featurene (objektene) som tilhører featureklassen, setter peker til 1 feature:

Set pFeatureCursor = pFeatureClass.Search(Nothing, True)

Set pFeature = pFeatureCursor.NextFeature

i = 0

 

text = ""

 

i = 0

'Løkke som går gjennom alle features som tilhører featureklassen:

Do Until (pFeature Is Nothing)

i = i + 1

 

Set pPointCollection = pFeature.Shape

MsgBox "Feature nr " & i & _

" Antall Punkt: " & pPointCollection.PointCount & vbCr

 

 

'beregner avstanden mellom punktene og summerer:

pytlengde = 0

pX1 = pPointCollection.Point(pPointCollection.PointCount - 1).X

py1 = pPointCollection.Point(pPointCollection.PointCount - 1).Y

 

'Går gjennom alle punktene i punktsamlingen:

For ii = 0 To pPointCollection.PointCount - 1

pX2 = pPointCollection.Point(ii).X

py2 = pPointCollection.Point(ii).Y

ds = Sqr((pX2 - pX1) * (pX2 - pX1) + (py2 - py1) * (py2 - py1))

pytlengde = pytlengde + ds

pX1 = pPointCollection.Point(ii).X

py1 = pPointCollection.Point(ii).Y

 

Next ii

 

'Sammenligner beregna lengde med "systemlengde":

Set pPolygon = pFeature.Shape

MsgBox "Lengde: " & pPolygon.Length & " / " & pytlengde

 

'Klar for neste feature, dvs en runde til i løkka:

Set pFeature = pFeatureCursor.NextFeature

Loop

 

MsgBox "Antall objekter funnet: " & i

 

End If

 

'Innenfor denne With-løkken trengs ikke spesifikasjon på at det er objektet newdoc som behandles:

With newdoc

'Teller hvor mange avsnitt som finnes på. Et avsnitt er det som avsluttes med Enter-knappen (vBCr)

I1 = .Paragraphs.Count

 

'Setter inn tekst etter siste avsnitt:

.Paragraphs(I1).range.InsertAfter text:="!Generert fra ArcMap " & Date & vbCr

 

'Setter Heading2 som format på avsnittet:

.Paragraphs(I1).Format.Style = wdStyleHeading2

 

'Teller hvor mange ord som er i Word-dokumentet:

I3 = newdoc.Words.Count

 

'Markerer siste ordet:

newdoc.Words(I3).Select

 

'Setter inn en ny tabell med 2 rader og 3 kolonner etter markert tekst

Set table = .Tables.Add(objword.Selection.range, 2, 3)

 

'Formaterer tabellen med Grid1-formatering:

table.AutoFormat Format:=wdTableFormatGrid1

 

'Setter bredden på kolonnene i tabellen:

table.Columns(1).Width = InchesToPoints(0.7)

table.Columns(2).Width = InchesToPoints(1.7)

table.Columns(3).Width = InchesToPoints(2.7)

 

'Setter inn tekst i noen av cellene i tabellen:

table.Cell(1, 1).range.text = "Rute (1,1)"

table.Cell(1, 2).range.text = "Rute (1,2)"

table.Cell(2, 1).range.text = "Rute (2,1)"

table.Cell(2, 3).range.text = "Rute (2,3)"

 

 

'Skriver mer tekst på slutten av dokumentet (etter tabellen)

.Content.InsertAfter text:="Username: " & objword.UserInitials & " / " & objword.UserName & vbCr

 

 

.Content.InsertAfter text:="!Dette er slutten " & Date & vbCr

 

 

'Setter inn enda en ny rad i tabellen som ble opprettet over:

'Legg merke til at objektpekeren ennå peker til tabellen, ikke til slutten på fila.

table.Rows.Add

'Fyller ei celle i den nye raden med tekst:

table.Cell(3, 3).range.text = "Rute (3,3)"

 

 

 

 

End With

 

objword.Quit

 

 

End Sub

 

 

'Har behandla alle featureklasser i denne layeren, klar for neste layer

Set pFeatureLayer = pEnumLayer.Next

Loop

 

 

End Sub

[jajajalla]

Private Sub UIButtonControl1_Click()

 

Dim pMxDoc As IMxDocument

Set pMxDoc = ThisDocument

 

Dim pUID As New UID

pUID = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}" 'IGeoFeatureLayer IID

 

Dim pEnumLayer As IEnumLayer

 

Dim pFeatureLayer As IFeatureLayer

Dim pFeatureClass As IFeatureClass

Dim pFeatureCursor As IFeatureCursor

Dim pFeature As IFeature

Dim pPointCollection As IPointCollection

 

Dim pPolygon As IPolygon

 

 

 

'Varibler for koordinat-beregning

Dim pytlengde As Double

Dim pX1 As Double

Dim py1 As Double

Dim pZ1 As Double

Dim pX2 As Double

Dim py2 As Double

Dim pZ2 As Double

Dim ds As Double

 

 

End Sub

 

'--------Klargjøring av Word-fil for skriving:--------------------

Sub WordSkriving()

 

Dim objword As Word.Application

Dim newdoc As Word.Document

Dim table As Word.table

Dim I1 As Long

Dim I3 As Long

 

Dim NormalStyle As String

 

 

NormalStyle = "normal"

 

On Error Resume Next ' Defer error trapping.

Set objword = GetObject(, "Word.Application")

If Err.Number <> 0 Then

 

'MsgBox ("Word er ikke startet, men startes opp når du har klikket OK")

Set objword = CreateObject("Word.Application")

Err.Clear ' Clear Err object in case error occurred.

 

 

Else

'MsgBox ("Word er startet opp allerede. Legger kun til nytt dokument.")

End If

 

'Skrur av feilbehandleren

On Error GoTo 0

 

'Gjør Word-vinduet synlig på skjermen

objword.Visible = True

 

'Lager et nytt dokument i word-objektet

Set newdoc = objword.Documents.Add '(Template:="Sosiv3D.dot")

 

 

'-----klargjøring av Word-fil er ferdig--------------------------

 

Dim dTotalArea As Double

 

Dim i As Long

Dim text As String

 

 

'Klargjør liste av layere i aktivt vindu, setter layer-"peker" til starten på samlingen:

Set pEnumLayer = pMxDoc.FocusMap.Layers(pUID, True)

pEnumLayer.Reset

 

Set pFeatureLayer = pEnumLayer.Next

'Løkke som går gjennom alle layere:

Do Until (pFeatureLayer Is Nothing)

 

MsgBox "Layernavn/Shapetype : " & pFeatureLayer.Name & " / " & pFeatureLayer.FeatureClass.ShapeType

 

If (pFeatureLayer.FeatureClass.ShapeType = esriGeometryPolygon) Then

 

MsgBox "Antall objekter i layeren: " & pFeatureLayer.FeatureClass.FeatureCount(Nothing)

 

'Behandler featureklassen som tilhører layeren (kun en featureklasse pr layer)

Set pFeatureClass = pFeatureLayer.FeatureClass

MsgBox "Antall felt i attributt-tabellen: " & pFeatureClass.Fields.FieldCount

 

 

'Løkke som går gjennom alle fields i featureklassen:

For i = 0 To (pFeatureClass.Fields.FieldCount - 1)

 

MsgBox "Felt (" & i & ") : " & pFeatureClass.Fields.Field(i).Name & _

" / " & pFeatureClass.Fields.Field(i).Type & _

" / " & pFeatureClass.Fields.Field(i).VarType & _

" / " & pFeatureClass.Fields.Field(i).Required & _

vbCr

Next i

 

'Behandler enkelt-featurene (objektene) som tilhører featureklassen, setter peker til 1 feature:

Set pFeatureCursor = pFeatureClass.Search(Nothing, True)

Set pFeature = pFeatureCursor.NextFeature

i = 0

 

text = ""

 

i = 0

'Løkke som går gjennom alle features som tilhører featureklassen:

Do Until (pFeature Is Nothing)

i = i + 1

 

Set pPointCollection = pFeature.Shape

MsgBox "Feature nr " & i & _

" Antall Punkt: " & pPointCollection.PointCount & vbCr

 

 

'beregner avstanden mellom punktene og summerer:

pytlengde = 0

pX1 = pPointCollection.Point(pPointCollection.PointCount - 1).X

py1 = pPointCollection.Point(pPointCollection.PointCount - 1).Y

 

'Går gjennom alle punktene i punktsamlingen:

For ii = 0 To pPointCollection.PointCount - 1

pX2 = pPointCollection.Point(ii).X

py2 = pPointCollection.Point(ii).Y

ds = Sqr((pX2 - pX1) * (pX2 - pX1) + (py2 - py1) * (py2 - py1))

pytlengde = pytlengde + ds

pX1 = pPointCollection.Point(ii).X

py1 = pPointCollection.Point(ii).Y

 

Next ii

 

'Sammenligner beregna lengde med "systemlengde":

Set pPolygon = pFeature.Shape

MsgBox "Lengde: " & pPolygon.Length & " / " & pytlengde

 

'Klar for neste feature, dvs en runde til i løkka:

Set pFeature = pFeatureCursor.NextFeature

Loop

 

MsgBox "Antall objekter funnet: " & i

 

End If

 

'Innenfor denne With-løkken trengs ikke spesifikasjon på at det er objektet newdoc som behandles:

With newdoc

'Teller hvor mange avsnitt som finnes på. Et avsnitt er det som avsluttes med Enter-knappen (vBCr)

I1 = .Paragraphs.Count

 

'Setter inn tekst etter siste avsnitt:

.Paragraphs(I1).range.InsertAfter text:="!Generert fra ArcMap " & Date & vbCr

 

'Setter Heading2 som format på avsnittet:

.Paragraphs(I1).Format.Style = wdStyleHeading2

 

'Teller hvor mange ord som er i Word-dokumentet:

I3 = newdoc.Words.Count

 

'Markerer siste ordet:

newdoc.Words(I3).Select

 

'Setter inn en ny tabell med 2 rader og 3 kolonner etter markert tekst

Set table = .Tables.Add(objword.Selection.range, 2, 3)

 

'Formaterer tabellen med Grid1-formatering:

table.AutoFormat Format:=wdTableFormatGrid1

 

'Setter bredden på kolonnene i tabellen:

table.Columns(1).Width = InchesToPoints(0.7)

table.Columns(2).Width = InchesToPoints(1.7)

table.Columns(3).Width = InchesToPoints(2.7)

 

'Setter inn tekst i noen av cellene i tabellen:

table.Cell(1, 1).range.text = "Rute (1,1)"

table.Cell(1, 2).range.text = "Rute (1,2)"

table.Cell(2, 1).range.text = "Rute (2,1)"

table.Cell(2, 3).range.text = "Rute (2,3)"

 

 

'Skriver mer tekst på slutten av dokumentet (etter tabellen)

.Content.InsertAfter text:="Username: " & objword.UserInitials & " / " & objword.UserName & vbCr

 

 

.Content.InsertAfter text:="!Dette er slutten " & Date & vbCr

 

 

'Setter inn enda en ny rad i tabellen som ble opprettet over:

'Legg merke til at objektpekeren ennå peker til tabellen, ikke til slutten på fila.

table.Rows.Add

'Fyller ei celle i den nye raden med tekst:

table.Cell(3, 3).range.text = "Rute (3,3)"

 

 

 

 

End With

 

objword.Quit

 

 

End Sub

 

 

'Har behandla alle featureklasser i denne layeren, klar for neste layer

Set pFeatureLayer = pEnumLayer.Next

Loop

 

 

End Sub

Har ikke giddi å gå igjennom hele koden som du lurer på,

skjønt du har kanske allerede fått svar nå.

Uansett så kan jeg ikke finne ut hva som er galt

uten at du sier hva slags error du får ol....