automatisch openen van vbaform vanuit .dotm

Status
Niet open voor verdere reacties.
D

dropje4

Gebruiker
Lid geworden
20 feb 2017
Berichten
5
Ik heb een dotm gemaakt welke een userform aan moet roepen.
Wanneer ik de .dotm open vanuit de explorer (via rechtsklik en optie Open) dan werkt het.
Klik ik nu rechtstreeks op de dotm dan wordt een document1.doc gecreeerd zonder dat het userform en de daarin gedefinieerde vragen gebruikt wordt.
Wat doe ik verkeerd?

In ThisDocument staat code:
Code: 
Sub Document_Add()
 Dim oFrm As UserForm1
 Set oFrm = New UserForm1
oFrm.Show
 Unload oFrm
 Set oFrm = Nothing
 End Sub

In Forms (UserForm1)
Code: 
Private Sub cmdCancel_Click()
    Unload Me
    ActiveDocument.Close SaveChanges:=False
End Sub
Private Sub cmdOK_Click()

   Dim str_Auditor
   Dim str_Auditnummer
   Dim str_Sender
   Dim str_Auditinfo
   Dim str_Auditmail
   Dim strDocName As String
   Dim intPos As Integer
      
   str_Auditor = ""
   str_Auditnummer = ""
   str_Sender = ""
   str_Auditinfo = ""
   str_Auditmail = ""
     
   ' Find position of extension in file name
   strDocName = "SQQ" & Auditnummer.Value & ".doc"
   intPos = InStrRev(strDocName, ".")
 
   If intPos = 0 Then
 
        ' If the document has not yet been saved
        ' Ask the user to provide a file name
        strDocName = InputBox("Please enter the name " & _
            "of your document.")
   Else
 
        ' Strip off extension and add ".doc" extension
        strDocName = Left(strDocName, intPos - 1)
        strDocName = "SQQ" & Auditnummer.Value & ".doc"
   End If
   
   ' Save file with new extension
    ActiveDocument.SaveAs2 FileName:=strDocName, _
        FileFormat:=wdFormatDocument
     
   Application.ScreenUpdating = False
    With ActiveDocument
      .Bookmarks("Auditor").Range.Text = Auditor.Value
      .Bookmarks("Auditnummer").Range.Text = Auditnummer.Value
      .Bookmarks("Sender").Range.Text = Auditor.Value
      .Bookmarks("Auditinfo").Range.Text = Auditnummer.Value
      .Bookmarks("Auditmail").Range.Text = Auditmail.Value
    
          
    End With
    
    Application.ScreenUpdating = True
    Unload Me
End Sub

Ik maak ergens een denkfout, maar kijk er blijkbaar overheen.

Iemand enig idee??

Dank!

John.
 
Laatst bewerkt:
Welkom bij HelpMij, maar doe ons een lol en zet de code uit je vorige bericht in code tags met de CODE knop ( # ).
Zo is het niet te lezen. Kwestie van < vervangen door [ trouwens :).
 
Bedankt :). Sjablonen maken nieuwe documenten aan, dus openen van een sjabloon is niet handig, want dan gebruik je de sjabloon verkeerd. Je moet het formulier dus openen bij de gebeurtenis New. En dan krijg je deze simpele startmacro in de module ThisDocument:
Code: 
Private Sub Document_New()
    UserForm1.Show
End Sub
 
Zie, ik maakte een denkfout :rolleyes:. De oplossing was simpel en effectief! Dank!!
 
Laatst bewerkt:
Rest je alleen nog de code in het Userform naar hooguit 4 regels terug te brengen.
 
Dank voor jullie hulp !

Code: 
Private Sub cmdCancel_Click()
    Unload Me
    ActiveDocument.Close SaveChanges:=False
End Sub
Private Sub cmdOK_Click()

   ' Find position of extension in file name
   strDocName = "SQQ" & Auditnummer.Value & ".doc"
        
   ' Save file with new extension
    ActiveDocument.SaveAs2 FileName:=strDocName, _
        FileFormat:=wdFormatDocument
     
   Application.ScreenUpdating = False
    With ActiveDocument
      .Bookmarks("Auditor").Range.Text = Auditor.Value
      .Bookmarks("Auditnummer").Range.Text = Auditnummer.Value
      .Bookmarks("Sender1").Range.Text = Auditor.Value
      .Bookmarks("Sender2").Range.Text = Auditor.Value
      .Bookmarks("Auditinfo").Range.Text = Auditnummer.Value
      .Bookmarks("Auditmail").Range.Text = Auditmail.Value
    
          
    End With
    
    Application.ScreenUpdating = True
    Unload Me
End Sub

Dank je; heb 'm gestript, alles werkt nu. Was eerst bezig met alles in strings te zetten, maar later de makkelijkere weg gezocht. Oude code was blijven staan. Was echt mijn eerste VBS scriptje!

Bedankt voor jullie hulp.:thumb:
 
Code: 
Private Sub cmdOK_Click()
  ActiveDocument.SaveAs2 "SQQ" & Auditnummer.Value & ".doc",wdFormatDocument
     
  for each it in split("Auditor Auditnummer Sender1 Sender2 Auditinfo Auditmail")
    ActiveDocument.Bookmarks(it).Range.Text = me(it).Value
  next       
    
  Unload Me
End Sub
 
Code: 
 ActiveDocument.Bookmarks(it).Range.Text = me(it).Value

Wauw, het kan dus stukken korter! Bij mij loopt hij alleen op het bovenstaande stuk vast met een run-time error (Could not find the specified object). Ik denk omdat ik in mijn eerste script ook bepaalde waarden doorkopier. Als ik deze nl. als bookmark invoeg in het WORD document lijkt hij ze per sectie maar 1 keer te kunnen gebruiken (vandaar Sender1 en Sender2 die dezelfde waarde moeten hebben).

Dank je voor de hulp en "understanding VBA". Super!:thumb: Ga hem aanpassen.

John.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan