Domino 9 und frühere Versionen > Entwicklung

Adressenetiketten aus LN erstellen

<< < (2/7) > >>

ata:
... ich hab noch nen Code in meiner KB - allerdings nicht explicit getestet...


--- Code: ---This one is for easyly create Labels with MS-Word

Code

' Sample Usage:

Sub Click(Source As Button)
Call CreateMailingLabels("Title","FirstName, LastName" ,
"OfficeStreetAddress","Zip","City" , True , 5 , "L7690")
End Sub


Sub CreateMailingLabels(Line1Fields As Variant ,_
Line2Fields As Variant ,_
Line3Fields As Variant ,_
Line4Fields As Variant ,_
Line5Fields As Variant ,_
Skip As Variant ,_
ColCount As Integer ,_
LabelTemplate As String)

Const OLE_OBJECT = "Word.Application"

Dim ws As New NotesUIWorkspace
Dim s As New NotesSession
Dim db As notesdatabase
Dim doc As NotesDocument
Dim dc As NotesDocumentCollection
Dim wrd As Variant
Dim LabelCount As Long
Dim DivMod As Integer

cr = Chr ( 13 ) & Chr ( 10 )
wdCell = 12
LabelCount=1
DivMod = 1

Set db = s.CurrentDatabase
Set dc=db.UnProcessedDocuments

Set wrd = CreateObject ( OLE_OBJECT )
Call wrd.Documents.Add
Call wrd.MailingLabel.CreateNewDocument ( LabelTemplate )
wrd.visible = True
Set doc=dc.GetFirstDocument

While Not doc Is Nothing
LabelAddress = GetListFieldValues ( doc , Line1Fields ) & cr '//
Build label text
LabelAddress = LabelAddress & GetListFieldValues ( doc , Line2Fields
) & cr
LabelAddress = LabelAddress & GetListFieldValues ( doc , Line3Fields
) & cr
LabelAddress = LabelAddress & GetListFieldValues ( doc , Line4Fields
) & cr
LabelAddress = LabelAddress & GetListFieldValues ( doc , Line5Fields )

If Not SingleColumn% Then
Call wrd.Selection.TypeText ( LabelAddress ) '// Insert Label
Text
On Error Goto TrapSingleColumn

If Skip = False Then
Call wrd.Selection.MoveRight ( wdCell ) ' Move one cell to
the right.
Else
If DivMod = 0 Then
Call wrd.Selection.MoveRight ( wdCell ) ' Move one
cell to the right.
Else
Call wrd.Selection.MoveRight ( wdCell ) ' Move one
cell to the right.
Call wrd.Selection.MoveRight ( wdCell ) ' Move one
cell to the right.
End If
End If

If SingleColumn% Then
Call wrd.MailingLabel.CreateNewDocument ( LabelTemplate ,
LabelAddress )
End If

Else
Call wrd.MailingLabel.CreateNewDocument ( LabelTemplate ,
LabelAddress )
End If

LabelCount = LabelCount + 1

If ColCount = 2 Then
DivMod = 1
Else
DivMod = Labelcount Mod ColCount
End If

Set doc = dc.GetNextDocument ( doc )

Wend

Exit Sub

TrapSingleColumn:
SingleColumn% = True
Resume Next

End Sub

Function GetListFieldValues ( doc As NotesDocument , FieldList As Variant ) As
String
Dim TempList As String
Dim TempOutput As String
Dim TempArray As Variant
Dim ThisField As String

TempList = FieldList
TempOutput = ""
If TempList <> "" Then
' parse list of fields
While Len ( TempList ) > 0
If Instr ( TempList , "," ) > 0 Then
ThisField = Trim ( Left$ ( TempList , Instr ( TempList ,
"," ) - 1 ) )
TempList = Right$ ( TempList , Len ( TempList ) - Instr (
TempList , "," ) )
Else
ThisField = Trim ( TempList )
TempList = ""
End If
' retrieve notes field <WHATLE


--- Ende Code ---

ata

eknori:

--- Zitat ---This one is for easyly create Labels with MS-Word
--- Ende Zitat ---

auch reingefallen  :D ; es soll doch eine reine LN Lösung sein. 8)

ata:
... upps - wer lesen kann ist im Vorteil...  ;D - sorry

ata

Rootine:
ok, einfach mal so dahergedacht:
der kunde muss ja vorher irgendwo dem system bekannt geben welche etiketten schon verbraucht worden sind. diese etikettenfelder würd ich dann einfach als belegte felder behandeln in denen immer die gleiche andresse drinnen steht, nämlich eine leere.

lg
roo

Rob Green:
dann schau Dir NotesToPaper an...mögl. wäre das etwas. Koscht aber.

Navigation

[0] Themen-Index

[#] Nächste Seite

[*] Vorherige Sete