Exporteren naar WORD

[Excelvbas01]

Missschien een moeilijke weg gekozen maar dat is wat ik wilde.
AHulpje heeft enorm geholpen en heel erg bednakt.
Ik bedank allen die meegadacht hebben.
:thumb:

 

[OctaFish]

AHulpje heeft enorm geholpen en heel erg bednakt.

Ik niet dan? En ik was nog wel zó tevreden over de code die ik in bericht #14 voor je gemaakt heb….

 

[AHulpje]

[Ironie]Octafish verdient ook een aai over de bol, al was ik ook érg tevreden over mijn code.[/Ironie]

 

[OctaFish]

We weten allemaal dat jij de AllerH​oogste bent .

 

[Excelvbas01]

Ik heb iedereen bedankt en ook OctaFish.
jullie beiden zijn toppers....:thumb:

 

[Excelvbas01]

Gaande weg kom je toch dingen tegen die je graag anders wil.
Ik wil graag cel "adres" Mergen met cel C. Dus B en C samen.
Mijn vraag is, hoe kan ik de twee codes samen voegen, Mergen en dan wegschrijven. Geprobeerd maar kom helaas niet uit.

Dim rng As Range
MergeCells:
For Each rng In Selection
If rng.Value = rng.Offset(1, 0).Value And rng.Value <> "" Then
Range(rng, rng.Offset(3, 1)).Merge
Range(rng, rng.Offset(3, 1)).HorizontalAlignment = xlCenter
Range(rng, rng.Offset(3, 1)).VerticalAlignment = xlCenter
GoTo MergeCells

 Dim LastRow As Integer
    Dim r As Integer

    With Sheets("Word1")
        .Activate
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 2
        If MsgBox("Wijzigingen doorvoeren ?", vbYesNo, "Wijziging") = vbYes Then
            VulItem LastRow, 1, "Naam", txtNaam.Text
            VulItem LastRow, 3, "Voornaam", txtVoornaam.Text
            VulItem LastRow + 1, 1, "Geb. Datum", txtgeb.Text
            VulItem LastRow + 1, 3, "Geslacht", txtGesl.Text
            VulItem LastRow + 2, 1, "Email", txtEmail.Text
            VulItem LastRow + 2, 3, "Mobiel", txtMobiel.Text
            VulItem LastRow + 3, 1, "Adres", txtAdres.Text 'deze wil ik mergen met kolom b en C
            VulItem LastRow + 4, 1, "Nummer", txtNo.Text
            VulItem LastRow + 5, 1, "Foto", txtFoto.Text
            VulItem LastRow + 6, 1, "Text", txtTekst.Text
            r = 7
            If Me.CheckBox1 Then
                VulItem LastRow + r, 1, "Text1", txtTekst1.Text
                r = r + 1
            End If
            If Me.CheckBox2 Then
                VulItem LastRow + r, 1, "Text2", txtTekst2.Text
            End If
        End If
    End With
    Call Merge

Een ander vraag is: Hoe kan ik ervoor zorgen dat alleen de gevulde Tekstboxen weg kan schrijven zondewr tussenkomst van checkboxen.
Nu gebruik ik checkbox maar dat vind ik een omweg en onhandig.

Ik heb geen bestand bijgevoegd. Het bestand is hetzelfde als hiervoor.

 

[AHulpje]

Verwijder beide checkboxen en bijbehorende _click events.
Plak adres en nummer aan elkaar met een spatie ertussen:

VulItem LastRow + 3, 1, "Adres", txtAdres.Text & " " & txtNo.Text

Test of tekstboxen zijn gevuld i.p.v. CheckBoxen:

If Me.txtTekst1.Text <> vbNullString Then

Vergeet niet de rijnummers aan te passen.

En de Modules 1 t/m 3 kunnen ook wel weg denk ik.

 

[Excelvbas01]

Top :thumb:

Het samenvoegen van de text was ik al op de hoogte. Ik wil niet de Text maar de cellen samenvoege, Merge.
Het gaat in dit geval om Cel B (Adres) en de cel ernaast (C).

Deze code combineren met de onderstaande.

For Each rng In Selection
If rng.Value = rng.Offset(1, 0).Value And rng.Value <> "" Then
Range(rng, rng.Offset(3, 1)).Merge

en

VulItem LastRow + 3, 1, "Adres", txtAdres.Text 'deze wil ik mergen met kolom b en C

 

[AHulpje]

Welk doel wil je met het samenvoegen van die cellen bereiken?
Nou ja, als je het graag wilt:

Range(Cells(LastRow + 3, 2), Cells(LastRow + 3, 3)).Merge

 

[Excelvbas01]

Opgelost.
top:thumb:

 

[Excelvbas01]

In txtFoto heb ik een foto staan en deze wil ik exporteren naar Rij met de naam Foto.
VulItem LastRow + 5, 1, "Foto", Shapes.AddPicture = txtFoto

Wil maar niet werken. Weet iemand hoe ik foto op die plek kan krijge.

 

[AHulpje]

Dim shp As Shape
Set shp = ActiveSheet.Shapes.AddPicture(txtFoto, msoFalse, msoCTrue, Cells(LastRow + 5, 1).Left, Cells(LastRow + 5, 1).Top, 100, 100)

 

[Excelvbas01]

ik krijg fout melding.
Typen momen niet met elkaar overeen?

 

[AHulpje]

Op welke regel krijg je die foutmelding?
Stap met F8 door de code, en kijk naar de waarden van txtFoto en Lastrow.

 

[Excelvbas01]

Ik heb de regen hier boven toegevoegd maar krijg fout melding in die regel.

Misschien ligt het aan Image1. Ik heb namelijk txtFoto vervangen door Image1. In Image1 wordt de foto ingeladen en die probeer ik dus te exporteren naar de opgegeven rij.
Als ik Image1.Picture toevoeg in plaat van txtFoto dan krijg foutmelding dat het bestand is niet gevonden. Er is wel een foto aanwezig.

Fout 1004 tijdens uitvoering: bestand niet gevonden.

 

[AHulpje]

Had je wel een paraplu opgestoken?
Gebruik de filenaam van de foto, zie: AddPicture

 

[Excelvbas01]

Ja het regende hier......tikfoutje
Ik kan wel een foto vanaf folder exporteren maar dat wil ik niet, ik wil alleen de zichtbare foto in IMAGE1 ,voorheen txtFoto, naar blad WORD exporteren en dat werkt helaas niet. Ik heb geprobeerd met Copy maar werkt niet .......

 

[AHulpje]

Je hebt de naam en locatie van de foto, dus ik begrijp niet waarom je perse de image uit je form op het werkblad wilt plaatsen, daar maak je het jezelf alleen maar moeilijk mee. Maar vooruit:

Sub PicToSheet()
    Dim p As String
    p = Environ("temp") & "\" & Format(Now, "yymmdd-hhmmss") & ".bmp"
    SavePicture Me.Image1.Picture, p
    With ActiveSheet
        .Shapes.AddPicture p, msoFalse, msoCTrue, .Cells(1, 1).Left, .Cells(1, 1).Top, Me.Image1.Picture.Width / 100, Me.Image1.Picture.Height / 100
    End With
    Kill p
End Sub

 

[Excelvbas01]

Top