17. september 2006 - 11:57Der er
5 kommentarer og 1 løsning
VBA- Indsæt tekst i formular
Hej Experter. Er VBA nystarter. Hvem kan hjælpe mig med denne her?
Sheet1 er en std tilbudsformular for produkter. Ved klik på Cmd1 og/eller Cmd2 i Userform1 skal teksten salgsbetingelse1 og/eller salgsbetingelse2 aut indsættes i formularen. (Salgsbetingelsen skal forsvinde fra formularen hvis bruger fortryder valget og klikker på knappen een gang til) Salgsbetingelse er en længere tekst som jeg regner med at oprette i et tilfældigt placeret tekstfelt på Sheet2. Sheet2 vil jeg Hide for brugeren.
Antallet af tilbud på formularen varierer men det vil være bedst hvis salgsbetingelserne altid indsættes efter sidste tilbud i rækken – samme cellereference kan derfor formodentlig ikke bruges til at indsætte salgsbetingelser i for to forskellige tilbud, hver med varierende længde.
Kan man med VBA definerer den variable placeringen af området efter sidste tilbud i rækken eller er det bedst manuelt at selecte celle hvori teksten herefter indsættes ved click på Cmd? Er tekstfeltet en brugbar metode ved indsætning af tekst eller findes bedre metode? Hvilke koder skal bruges?
Worksheets("Kasse").Unprotect ("2241") ' fjerner arkbeskyttelse hvor koden er 2241 ' Henter navn fra formularen NyBarvagt feltet txtbarvagt ' Indsætter barvagtens navn i arket Kasse. ' I celle D11, hvis Celle D11 er udfyldt, så i D12 osv. ' Når D13 er udfyldt er der ikke plads til flere navne.
Dim C As Variant If Range("D11") = "" Then
Worksheets("Kasse").Activate C = 4 Do Until Worksheets("Kasse").Cells(C, 4) = "" C = C + 1 Loop Cells(C, 4) = NyBarvagt.txtBarvagt.Value Else MsgBox "Ikke plads til flere navne, resten må bruge sidste navn på listen" End If
Denne er vist bedre, den finder første tomme celle i kolonne B, og indsætter teksten der.
Private Sub bntOK_Click() Worksheets("Kasse").Unprotect ("2241")
If txtVarenr.Text = "" Then MsgBox "Skriv venligst Varenummer." txtVarenr.SetFocus Else B = 3 Do Until Worksheets("Kasse").Cells(B, 3) = "" B = B + 1 Loop Cells(B, 3) = Varesalg!txtVarenr.Value
Application.ScreenUpdating = False
End If ' nulstiller værdier i userform txtVarenr.Value = ""
On Error GoTo Fejl Sheets(1).Shapes("Tekst1").Delete ' sletter Tekstboksen, hvis den er der Exit Sub Fejl: ' hvis den ikke er der oprettes den, lige under sidste udfyldte celle i B kolonnen Sheets(1).Shapes.AddTextbox(msoTextOrientationHorizontal, Range("B65536").End(xlUp).Offset(1, 0).Left, _ Range("B65536").End(xlUp).Offset(1, 0).Top, 200#, 40#).Select Selection.Name = "Tekst1" Selection.Characters.Text = "salgsbetingelse1 " ' Her skal du skrive din salgsbetingelser
On Error GoTo Fejl Sheets(1).Shapes("Tekst1").Delete ' sletter Tekstboksen, hvis den er der Exit Sub Fejl: ' hvis den ikke er der oprettes den, lige under sidste udfyldte celle i B kolonnen Sheets(1).Shapes.AddTextbox(msoTextOrientationHorizontal, Sheets(1).Range("B65536").End(xlUp).Offset(1, 0).Left, _ Sheets(1).Range("B65536").End(xlUp).Offset(1, 0).Top, 200#, 40#).Select Selection.Name = "Tekst1" Selection.Characters.Text = "salgsbetingelse1 " ' Her skal du skrive din salgsbetingelser
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
