Flytte en celles tekstindhold til et word dokument

Hvor mange tekster er der tale om?
Hvad er formålet med rapporten (lidt baggrundsorientering)?
Hvordan skal det relevante billede identificeres og hvor kommer billederne fra?

En mulighed kunne være en tabel, der kunne indeholde billeder og teksten kunne hentes fra en Userform (hvis det siger dig noget),hvori alle teksterne kunne være anført - enten alfabetisk - evt. opdelt i kategorier.
Teksterne kunne godt være lagret i et Excel-ark. Det ville være muligt automatisk at få overført den valgte tekst...

-Hvis systemet kommer op at køre som jeg håber drejer det sig nok om 50-100 tekster af 1-2 liniers længde i et word dokument.

-rapporten beskriver tekst og §ér de fejl og mangler der måtte være, og som billederne visualiserer.

- Billederne kommer fra digicam og ligger lokalt på pcén i en mappe navngivet med adressen på tilsynet, men kunne også placeres andet sted hvis det var bedre. Billederne forventes scalleret inden brug.

- Userform er det ikke et slags rullegardin hvor alle så ligger i? Kan godt lide den med at de evt. var opdelt efter kategorier.

En userform er en form for dialogboks - dog med et brugerbestemt indhold i form af listbokse, combobokse, indtastningsfelter, knapper m.m. - afh. af hvad formålet er.

Er det noget vi skal gå videre med?

Userform - jep nu er jeg med. Har lige siddet og kigget i koden til et kørselsregnskabsprogram som jeg lavede tilbage i 2000 :-I
Der lavede jeg en userform med en del instastningsfelter, men hvordan det hele hænger sammmen kan jeg ikke huske.

Ja det kunne være spændende at arbejde videre med det.
Tror du det kan lade sig gøre at flytte teksterne fra en userform (f.eks.) til et worddokument eller ville det være bedre at lave det hele i excel?
Hvis man henter nogle tekster ind via en userform, kan det lade sig gøre at redigere i den inden den overføre til selve rapporten?

Alt er muligt!
Rapporten vil nok være bedst i Word - men det er dit valg.

Prøv at udarbejde 1 rapportside i Word og send den til: pb@supertekst-it.dk

Hvis du sender en mail til: pb@supertekst-it.dk
- så returnerer jeg en model....

Har sendt en tom mail, ved ikke om det var det du mente.
Har ikke haft tid til at fikse en rapportside i word endnu.

Det er ok - vender tilbage...

>>Version 2:
Har taget højde for, at ”reglement” indlæses i Userformen og at der kan opbygges flere bemærkninger.

Men jeg er lidt usikker på om hvordan reglement i øvrigt skal behandles.
Er det en del af søgekriteriet sammen med kategori - eller?<<

Ja det er sammen med kategori
Første vælges reglement dernæst de kategorier med tilhørende bemærkninger som du havde lavet i første version, lidt som stifinder.

Noget nyt?

Koden i Userform til valg af diverse tekster, der er lagret i regneark:

Rem Version 3: 04-06-08
Rem ===================
Const maxH = 350.25
Const minH = 99

Dim bemXls, sidsteRækXls
Dim sti
Private Sub CommandButton1_Click()                  'Indsæt
    Selection.TypeText Text:=Me.TextBox1
    Me.TextBox1 = ""                                'Slet tekstbox
   
    Me.CommandButton1.Enabled = False
End Sub
Private Sub CommandButton2_Click()                  'Luk
    lukBemærkninger
    Unload UserForm1
End Sub
Private Sub CommandButton3_Click()                  'Maximer/Minimer
    If Me.Height = maxH Then
        Me.Height = minH
    Else
        Me.Height = maxH
    End If
End Sub
Private Sub ListBox3_Click()                        'Reglement er valgt
    Me.ListBox1.Clear
    Me.ListBox2.Clear
   
    visKategorier Me.ListBox3
End Sub
Private Sub ListBox1_Click()                        'Kategori er valgt - visbemærkninger
'    Me.CommandButton1.Enabled = False
    Me.ListBox2.Clear
'    Me.TextBox1 = ""                              'tekstboksen slettes efter "Indsæt"
   
    visBemærkninger Me.ListBox1
End Sub
Private Sub ListBox2_Click()                        'Bemærkning er valgt
    If Me.TextBox1 = "" Then                        'Første bemærkning
        Me.TextBox1 = Me.ListBox2                  'indsæt valgte tekst i tekstboks for evt. redigering
    Else
        Me.TextBox1 = Me.TextBox1 + vbCr + ListBox2 'Hvis bemærkning i forvejen
    End If
   
    Me.CommandButton1.Enabled = True
End Sub
Private Sub userform_activate()
    Me.CommandButton1.Enabled = False
   
    sti = hentSti
    åbnBemærkninger
    visReglement
End Sub
Private Function hentSti()
    hentSti = ActiveDocument.Path
    If Right(hentSti, 1) <> "\" Then
        hentSti = hentSti + "\"
    End If
End Function
Private Sub åbnBemærkninger()
    Set bemXls = CreateObject("Excel.Application")
    With bemXls
        .workbooks.Open sti + "Tekster.xls"
    End With
   
    bemXls.Sheets(1).Activate
    sidsteRækXls = bemXls.ActiveCell.SpecialCells(xlLastCell).Row
End Sub
Private Sub lukBemærkninger()
On Error Resume Next
    bemXls.Application.Quit
    Set bemXls = Nothing
End Sub
Private Sub visReglement()
    Me.ListBox3.Clear
    For ræk = 2 To sidsteRækXls
        If bemXls.Cells(ræk, 1) <> "" Then
            Me.ListBox3.AddItem bemXls.Cells(ræk, 1)
        End If
    Next ræk
End Sub
Private Sub visKategorier(reglement)
Dim flag As Boolean
    Me.ListBox1.Clear
    flag = False
   
    For ræk = 2 To sidsteRækXls
Rem Find starten for reglement
        If CStr(bemXls.Cells(ræk, 1)) = reglement Then
            Me.ListBox1.AddItem bemXls.Cells(ræk, 2)
            flag = True
        Else
            If flag = True And bemXls.Cells(ræk, 1) = "" Then
                If bemXls.Cells(ræk, 2) <> "" Then
                    Me.ListBox1.AddItem bemXls.Cells(ræk, 2)
                End If
            Else
                If flag = True Then
                    Exit Sub
                End If
            End If
        End If
    Next ræk
End Sub
Private Sub visBemærkninger(kategori)
    Me.ListBox2.Clear
   
    bemXls.Sheets(1).Activate
    For ræk = 2 To sidsteRækXls
        If bemXls.Cells(ræk, 2) = kategori Then
            startKat = ræk
            Exit For
        End If
    Next ræk

    While bemXls.Cells(ræk, 2) = kategori Or bemXls.Cells(ræk, 2) = ""
        Me.ListBox2.AddItem bemXls.Cells(ræk, 3)
        ræk = ræk + 1
        If ræk > sidsteRækXls Then
            Exit Sub
        End If
    Wend
End Sub
Private Sub userform_terminate()
    lukBemærkninger
End Sub