Den tirsdag den 12. november 2013 19.40.28 UTC+1 skrev Barry Schwarz:
The first thing might be to show us the macros in question.
Hi.
The macro for inserting amount and price: (
https://dl.dropboxusercontent.com/u/28273423/TekstBlok.bas)
Public Sub Insert_text(Vare As String, Antal As Double, Pris As Double, sprog As String, valuta As String, Optional tekst As String)
Debug.Print "Text Start " & Time
Dim f As Integer
Dim sp As String, vare_ant As String, Vare2 As String
If sprog = "Dansk" Then sp = "01"
If sprog = "Engelsk" Then sp = "02"
If sprog = "Tysk" Then sp = "03"
If valuta = "DKK" Then valuta = "kr."
If valuta = "EUR" Then valuta = "€"
f = ActiveDocument.FormFields.Count
bogm = "a_" & f
Do While ActiveDocument.Bookmarks.Exists(bogm) = True
f = f + 1
bogm = "a_" & f
Loop
' DUMMY TEXT
If LCase(Vare) = "dummy" Then
Load Spec_vare
Call Spec_vare.ind(Antal, Pris)
Spec_vare.Show
Vare_kom = Spec_vare.Besk.Value
If Vare_kom = "" Then GoTo dummyslut
Vare_besk = ""
Antal = Spec_vare.Antal.Value
price = Spec_vare.Pris.Value
vare_ant = Spec_vare.Enhed.Value
Unload Spec_vare
GoTo indsæt
End If
Vare2 = Vare
åb
Vare_kom = kom(Vare, sp)
If Vare_kom = "" Then Vare_kom = kom(UCase(Vare), sp)
If Vare_kom = "" Then Vare_kom = tekst
If Vare_kom = "" And tekst = "" Then
MsgBox "Vare nr. " & ind & " findes ikke", vbMsgBoxSetForeground, "VARE NR."
Debug.Print "Vare nr. " & ind & " findes ikke"
Exit Sub
End If
Vare_besk = varetekst(Vare, sp)
If InStr(1, Vare_besk, Right(Vare, 6), vbBinaryCompare) = 0 Then
vare_farve = colorcode(Vare2, sp)
Vare_besk = Vare_besk & vare_farve
End If
vare_ant = Enhed(Vare)
If vare_ant = "" Then vare_ant = InputBox("Indtast salgsenhed for " & Vare_kom, "Mangler salgsenhed" & Chr(10) & "ST, L, M2, PK, M, KG, RL, KR, KS, SÆ, MM", "M2")
If vare_ant <> "" Then vare_ant = st(vare_ant, sp)
indsæt:
'ANTAL
Selection.FormFields.Add Range:=Selection.Range, Type:=wdFieldFormTextInput
Selection.MoveLeft unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.FormFields(1).Name = "a_" & f
ActiveDocument.FormFields("a_" & f).TextInput.EditType Type:=wdNumberText, Default:=Antal, format:="#.##0"
With ActiveDocument.FormFields("a_" & f)
.OwnHelp = True
.OwnStatus = True
.StatusText = Vare & Chr(10) & Vare_kom & Vare_besk
.HelpText = Vare_kom & Vare_besk
End With
Selection.EndKey
Selection.TypeText Text:=" " & vare_ant & Chr(10)
Selection.TypeText Text:=Vare_kom '& Chr(10)
If Vare_besk <> "" Then Selection.TypeText Text:=Vare_besk '& Chr(10)
'If Vare_col <> "" Then Selection.TypeText Text:=Vare_col
If sp = "01" Then Selection.TypeText Text:="Pr. " & vare_ant
If sp = "02" Then Selection.TypeText Text:="Each " & vare_ant
If sp = "03" Then Selection.TypeText Text:="Je. " & vare_ant
'á pris
Selection.TypeText Text:=Chr(9) & valuta & Chr(9)
Selection.FormFields.Add Range:=Selection.Range, Type:=wdFieldFormTextInput
Selection.MoveLeft unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.FormFields(1).Name = "p_" & f
ActiveDocument.FormFields("p_" & f).TextInput.EditType Type:=wdNumberText, Default:=Pris, format:="#.##0,00"
Selection.EndKey
'SUM
Selection.TypeText Text:=Chr(9) & valuta & Chr(9)
Selection.FormFields.Add Range:=Selection.Range, Type:=wdFieldFormTextInput
Selection.MoveLeft unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.FormFields(1).Name = "i_" & f
form = "=a_" & f & "*p_" & f
With Selection.FormFields(1)
.EntryMacro = ""
.ExitMacro = ""
.Enabled = False
.OwnHelp = False
.HelpText = ""
.OwnStatus = False
.StatusText = ""
With .TextInput
.EditType Type:=5, Default:=form, format:="#.##0,00"
.Width = 0
End With
End With
Selection.EndKey
Selection.TypeText Text:=Chr(10) & Chr(10)
dummyslut:
Debug.Print "Text Slut " & Time
End Sub
and for the total price: (
https://dl.dropboxusercontent.com/u/28273423/sum.bas)
Sub insert_sum() '(control As IRibbonControl)
Dim an
Dim a As Range
Set a = Selection.Range
Debug.Print a.End
b = ActiveDocument.Sections.Count
For q = 1 To b
Debug.Print ActiveDocument.Sections(q).Range.start
Debug.Print ActiveDocument.Sections(q).Range.End
If a.End > ActiveDocument.Sections(q).Range.start And a.End < ActiveDocument.Sections(q).Range.End Then
ud = q
Exit For
End If
Next q
an = ActiveDocument.Sections(q).Range.FormFields.Count
If an = 0 Then Exit Sub
Dim form1(100) As String
c = 0
For Each fl In ActiveDocument.Sections(ud).Range.FormFields
If Left(fl.Name, 2) = "i_" Then
form1(c) = fl.Name
c = c + 1
End If
Next fl
form = "=" & form1(0)
For u = 1 To c - 1
form = form & "+" & form1(u)
Next u
f = ActiveDocument.FormFields.Count
Selection.FormFields.Add Range:=Selection.Range, Type:=wdFieldFormTextInput
Selection.MoveLeft unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.FormFields(1).Name = "t_" & ud
With Selection.FormFields(1)
.EntryMacro = ""
.ExitMacro = ""
.Enabled = False
.OwnHelp = False
.HelpText = ""
.OwnStatus = False
.StatusText = ""
With .TextInput
.EditType Type:=5, Default:=form, format:="#.##0,00"
.Width = 0
End With
End With
Selection.EndKey
Selection.InsertBreak Type:=wdSectionBreakContinuous
End Sub
Function RoundUp(tal, decimaler As Double)
If Round(tal, decimaler) < tal Then
RoundUp = Round(tal, decimaler) + 1 / 10 ^ decimaler
Else
RoundUp = Round(tal, decimaler)
End If
End Function
Function MRound(number, roundedNumber) As Long
MRound = Round(number / roundedNumber, 0) * roundedNumber
'MsgBox MRound
End Function
Public Function RoundCeiling(tal As Double, afrund As Double) As Double
If Abs(tal - (Int(tal / afrund) + 1) * afrund) < afrund Then
RoundCeiling = (Int(tal / afrund) + 1) * afrund
Else
RoundCeiling = (Int(tal / afrund)) * afrund
End If
End Function
Sub total_sum()
Dim form()
s = ActiveDocument.Sections.Count
a = Selection.Range.start
ReDim form(s - 3)
For f = 3 To s
Selection.GoTo What:=wdGoToBookmark, Name:="t_" & f
navn = Selection.FormFields(1).Name
form(f - 3) = navn
Selection.HomeKey unit:=wdLine
Selection.EndKey unit:=wdLine, Extend:=wdExtend
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="sub_" &navn
Selection.SetRange start:=a, End:=a
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="ref " & "sub_" & navn
Selection.Fields.Update
Selection.EndKey unit:=wdLine
Selection.TypeParagraph
a = Selection.Range.start
Next f
form_ud = form(0)
For ff = 1 To UBound(form)
form_ud = form_ud & "+" & form(ff)
Next ff
Selection.TypeText Text:="Samlet" & vbTab & vbTab & vbTab & "kr." & vbTab
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="=" & form_ud
Selection.Fields.Update
End Sub
Hopes this helps.
bgr, Steffen
