Word VBA, beforePrint?

EDIT: bereits kurz nach Fragestellung selbst gelöst mit cancel =true nach Print background.... Verzeihung, war in der Arbeit und konnte erst jetzt eure Antworten sehen. Trotzdem vielen Dank!

Hallo zusammen.

Ich würde gerne einen commandButton kurz vor dem Drucken verkleinern und nach dem Drucken wieder groß anzeigen. Leider wird das Dokument zweimal ausgedruckt.

es soll beim normalen drucken passieren.

der befehl für das Druck event:

Private Sub appWord_DocumentBeforePrint _
 (ByVal Doc As Document, _
 Cancel As Boolean)
CommandButton1.Height = 0.75
CommandButton1.Width = 0.75
CommandButton2.Height = 0.75 CommandButton2.Width = 0.75


ActiveDocument.PrintOut Background:=False


CommandButton1.Height = 24 CommandButton1.Width = 100 CommandButton1.PicturePosition = fmPicturePositionRightTop

CommandButton2.Height = 24
CommandButton2.Width = 461
  End Sub

Das intializieren

Private Sub Document_New()
Set appWord = Word.Application
End Sub
' Private Sub Document_Open() Set appWord = Word.Application

End Sub

3 Antworten

derDennis99de

22.07.2019, 10:28

Hallo,

soll der Button ganz verschwinden oder wirklich nur kleiner angezeigt werden? oder ehr gesagt warum möchtest du den Button kleiner machen?

Gruß

Dennis

336spencer

22.07.2019, 10:46

Das frage ich mich auch...

Suboptimierer

22.07.2019, 10:45

Wenn du in das Event gelangst, ist der Druck bereits ausgelöst worden. Im Event druckst du dann erneut, was erklärt, weshalb du zwei Ausdrucke hast.

Du solltest innerhalb des BeforePrint-Events Cancel auf True setzen.

Sollte ActiveDocument.PrintOut das Ereignis erneut triggern (ausprobieren), kannst du die Ereignisbehandlung vorübergehend mit EnableEvents = False deaktivieren.

Statt die Buttons klein zu machen, kannst du auch einmal probieren, sie auf unsichtbar zu setzen oder schauen, ob es an ihnen eine Eigenschaft gibt, mit der eingestellt werden kann, ob sie gedruckt werden. Oder du schaust mal in den Druckeinstellungen der Applikation (Seite einrichten oder so), ob man einstellen kann, dass Steuerelemente nicht gedruckt werden.

xGlumi

22.07.2019, 10:54

Eine kleine Ergänzung zu deiner Antwort:

Wenn du in das Event gelangst, ist der Druck bereits ausgelöst worden

Das ist nicht ganz richtig.

Wenn man in das Event gelangt, dann befindet man sich noch vor dem Drucken, und kann den eigentlichen Druck-Vorgang mit "cancel = true" stoppen.

MFG xGlumi

Suboptimierer

22.07.2019, 11:04

@xGlumi

Dass Cancel auf True gesetzt werden sollte, entspricht genau meinem Ratschlag.

Der Druck wurde ausgelöst, denn sonst wüsste der Interpreter nicht, dass er in das Ereignis BeforePrint einsteigen soll.

Das Auslösen des Drucks geschieht aus der Applikation heraus, zum Beispiel über einen Klick auf das Druckersymbol. Ob der Druck abgebrochen wird oder nicht, ändert nichts daran, dass der Druck ausgelöst wurde.

xGlumi

22.07.2019, 13:55

@Suboptimierer

Ok, dann habe ich deine Aussage nur falsch ausgefasst, entschuldige.

Es kam mir so rüber, als wenn du ausgesagst hast, dass der Druck (Request an den Drucker) bereits ausgelöst wurde.

Dann ignorier meinen Kommentar einfach :)

MFG xGlumi

xGlumi

22.07.2019, 10:58

Du kannst deine eigene Drucklogik schreiben (Ohne dass Word selbst nocheinmal zusätzlich druckt), indem du als erstes die "cancel"-Variable auf "true" setzt.

Anschließend kannst du deinen eigenen Druck ausführen.

MFG xGlumi

Woher ich das weiß:eigene Erfahrung

Hey :) kann mir da jemand weiterhelfen. ich weiß nicht ganz wie ich es schaffe, dass das Komma richtig berechnet wird und nicht nur so angezeigt wird. bin über jede hilfe dankbar. 1 stunde hab ich noch zeit bevor ich die hausübung hochladen muss x_x nächstes mal schieb ichs lieber nicht die ganzen ferien auf

Option Explicit Dim Zahl1 As Integer Dim Zahl2 As Integer Dim Operator As String Dim zähler As Long

Private Sub cb0_Click() Me.tbanzeige = Me.tbanzeige & "0" End Sub

Private Sub cb1_Click() Me.tbanzeige = Me.tbanzeige & "1" End Sub

Private Sub cb2_Click() Me.tbanzeige = Me.tbanzeige & "2" End Sub

Private Sub cb3_Click() Me.tbanzeige = Me.tbanzeige & "3" End Sub

Private Sub cb4_Click() Me.tbanzeige = Me.tbanzeige & "4" End Sub

Private Sub cb5_Click() Me.tbanzeige = Me.tbanzeige & "5" End Sub

Private Sub cb6_Click() Me.tbanzeige = Me.tbanzeige & "6" End Sub

Private Sub cb7_Click() Me.tbanzeige = Me.tbanzeige & "7" End Sub

Private Sub cb8_Click() Me.tbanzeige = Me.tbanzeige & "8" End Sub

Private Sub cb9_Click() Me.tbanzeige = Me.tbanzeige & "9" End Sub

Private Sub cbdurch_Click() Zahl1 = Me.tbanzeige.Text Operator = "/" Me.tbanzeige.Text = "" End Sub

Private Sub cbend_Click() End End Sub

Private Sub cbhae_Click() Me.tbanzeige = Me.tbanzeige & "Gib doch endlich eine Rechnung ein" End Sub

Private Sub cbist_Click() Zahl2 = Me.tbanzeige.Text If Operator = "+" Then Me.tbanzeige.Text = Zahl1 + Zahl2 ElseIf Operator = "-" Then Me.tbanzeige.Text = Zahl1 - Zahl2 ElseIf Operator = "*" Then Me.tbanzeige.Text = Zahl1 * Zahl2 ElseIf Operator = "/" Then Me.tbanzeige.Text = Zahl1 / Zahl2 End If

Operator = "="

End Sub

Private Sub cblöschen_Click() Me.cblöschen = "" End Sub

Private Sub L_Text_Click()

End Sub

Private Sub cbkomma_Click() Me.tbanzeige = Me.tbanzeige & "," End Sub

Private Sub cbloeschen_Click() Me.tbanzeige.Text = ""

End Sub

Private Sub cbmal_Click() Zahl1 = Me.tbanzeige.Text Operator = "*" Me.tbanzeige.Text = "" End Sub

Private Sub cbminus_Click() Zahl1 = Me.tbanzeige.Text Operator = "-" Me.tbanzeige.Text = "" End Sub

Private Sub cbplus_Click() Zahl1 = Me.tbanzeige.Text Operator = "+" Me.tbanzeige.Text = "" End Sub

Private Sub CommandButton1_Click() Userform1.Show End Sub End Sub

Private Sub CommandButton2_Click()

End Sub

Private Sub cbPrimzahl_Click() Zahl1 = Me.tbanzeige.Text Me.tbanzeige = "ist eine Primzahl"

For zähler = 2 To Sqr(Abs(Zahl1)) Me.tbanzeige = "ist eine Primzahl" If Abs(Zahl1) Mod zähler = 0 Then Me.tbanzeige = "ist keine Primzahl"

Exit For End If

Next zähler

End Sub

Private Sub UserForm_Click()

End Sub

...zur Frage

MS-Word VBA selection ausblenden

Hallo zusammen

Ich möche in Word mit VBA folgendes Bewerkstelligen:

Ein bestimmter Bereich soll je nach Wahl von Radio Buttons aus-und wieder eingeblendet werden können. Der Bereich enthält vor allem Formularsteuerelemente.

Ich bin schon soweit, dass ich ihn löschen kann, aber ich muss ihn je nach Wahl der Radio-Buttons auch wieder einblenden könne, darum geht löschen nicht.

Es geht also um die Eigenschaft von Selection.

Hier mein Code:

Private Sub OptionButton1_Click()
    'Kopierschutz auflösen
    ActiveDocument.Unprotect
        'Auswahltreffen und löschen
        Dim rngParagraphs As Range
        Set rngParagraphs = ActiveDocument.Range( _
            Start:=ActiveDocument.Bookmarks("ftxt1").Range.Start, _
            End:=ActiveDocument.Bookmarks("ftxt13").Range.End)
        rngParagraphs.Select
    
        Selection.Delete
        
    'Kopierschutz erstellen
    ActiveDocument.Protect wdAllowOnlyFormFields, NoReset:=True

End Sub

Private Sub OptionButton2_Click()
    'Kopierschutz auflösen
    ActiveDocument.Unprotect
        'Auswahltreffen und löschen
        Dim rngParagraphs As Range
        Set rngParagraphs = ActiveDocument.Range( _
            Start:=ActiveDocument.Bookmarks("ftxt1").Range.Start, _
            End:=ActiveDocument.Bookmarks("ftxt13").Range.End)
        rngParagraphs.Select
    
        Selection.
        
    'Kopierschutz erstellen
    ActiveDocument.Protect wdAllowOnlyFormFields, NoReset:=True
    
End Sub

...zur Frage

Word VBa Initialize funktioniert nicht?

Das ist mein Code:


Private Sub ComboBox1_Initialize()

  ComboBox1.AddItem "weisungsbefugt "
  ComboBox1.AddItem "Meier"
  ComboBox1.AddItem "Schmitz"
  ComboBox1.AddItem "Weber"
  ComboBox1.AddItem "Mustermann"

  .ListIndex = 1 'Vorbelegung


End Sub





Private Sub ComboBox1_Change()
    


    Dim sPfad As String


    Inhalt = get_Word_ContenField_as_Text("DropBox1")


    MsgBox Inhalt


    Exit Sub


End Sub

Nur leider funktioniert der Initilialize Teil einfach nicht und ich weiß nicht was ich falsch mache? Ich bitte um Hilfe. Danke!

...zur Frage

Ich benötige einen Makro, um ausgewählte Filter beim Schliessen zurück zu setzen. Aber mit dem Blattschutz funktioniert das nicht mehr. Kann mir jemand helfen?

Ich habe bisher diesen Makro benutzt:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim wksSheet As Worksheet
    For Each wksSheet In ThisWorkbook.Worksheets
        With wksSheet
            If .AutoFilterMode Then
                If .FilterMode Then
                    .ShowAllData
                End If
            End If
        End With
    Next wksSheet
    ThisWorkbook.Save
End Sub

...zur Frage

Excel VBA: Bild einfügen, in Variable speichern, Größe ändern, ausrichten?

Ich habe jetzt unzähle Varianten durch. Ich baue ein Bestellsystem für zwei verschieden Shops. Heißt, bei jedem eingetragenen Artikel in die Bestellliste soll am Ende der Listen-Zeile das jeweilige Logo eingefügt werden, kleiner als das Originalbild, kleiner als die Zeile selbst, für die Übersichtlichkeit in der Liste, mittig ausgerichtet.

Ich habe von Pictures.Insert zu Shapes.AddPicture gewechselt, da ich gelesen habe, dass dies die korrektere Form sei. Jetzt bekomme ich eine Fehlermeldung bei der Festlegung eines Rahmens.
Kann mir jemand meine Fehler aufzeigen? Folgende Fragen stellen sich mir:
- Welchen Variablen-Typ brauche ich für ein eingefügtes Bild?
- Wie kann ich diese Variable dann verwenden, um Größe, Position und Rahmen festzulegen?

Danke sehr!!!!!!

Sub LogoEinfügen(Shop As String, Zeile As Integer, Spalte As Integer)

Dim Breite As Integer
Dim Höhe As Integer
Dim strDatei As String
Dim Logo As Object
Dim ShopFarbe As Long, Rot As Long, Blau As Long

' Farben für die zwei Shops festlegen
Rot = 26316
Blau = 13395456

' Dateinamen je nach Shop auswählen und Shop-Farbe einstellen
If Shop = "ZL" Then
  strDatei = "D:\logo1.jpg"
  ShopFarbe = Rot
End If

If Shop = "AQ" Then
  strDatei = "D:\logo2.jpg"
  ShopFarbe = Blau
End If

' Bild einfügen

' Ort festlegen
Dim rg As Range
Set rg = ActiveSheet.Cells(Zeile, Spalte)

' Und einfügen
Set Logo = ActiveSheet.Shapes.AddPicture(strDatei, msoTrue, msoTrue, rg.Left, rg.Top, -1, -1)
Set rg = Nothing

With Logo
      .LockAspectRatio = msoFalse              ' Verzerrung egal
      .Height = Rows(Zeile).RowHeight - 4      ' kleiner als Zeile
      .Width = Columns(Spalte).Width - 4       ' schmaler als Spalte
      .Top = Cells(Zeile, Spalte).Top + (Cells(Zeile, Spalte).Height - Logo.Height) / 2         ' mittig
      .Left = Cells(Zeile, Spalte).Left + (Cells(Zeile, Spalte).Width - Logo.Width) / 2          ' mittig
  End With
  
  ' Rahmen ums Bild, in der Farbe des Shops
  With Logo.ShapeRange.Line
    .Visible = msoTrue
    .ForeColor.RGB = ShopFarbe
    .Weight = 1.5
    .ForeColor.TintAndShade = 0
  .ForeColor.Brightness = 0
End With

Set Logo = Nothing

' Zeilenhöhe anpassen
' Rows(Zeile).RowHeight = Logo.Height
 
End Sub

...zur Frage

VBA Code Outlook Mails als gelesen markieren?

Hallo zusammen,

ich habe ein VBA Script entdecken können, welches E-Mails beim Verschieben in einen bestimmten Ordner automatisch als gelesen markiert. Leider benötige ich diese Funktion aber für mehrere Ordner, bzw. eigentlich für alle (also immer wenn ich eine Mail in einen anderen Ordner verschiebe, soll diese als gelesen markiert werden).

Hat jemand eine Idee, wie ich dieses Script anpassen kann, oder ein anderes Script, damit das funktioniert?

Ich nutze ein Office 365, falls dies relevant ist.

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
  Dim Ns As Outlook.NameSpace
  Dim F As Outlook.MAPIFolder

  Set Ns = Application.GetNamespace("MAPI")
  Set F = Ns.GetDefaultFolder(olFolderInbox)
  Set F = F.Folders("test")
  Set Items = F.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
  Item.UnRead = False
  Item.Save
End Sub

Vielen lieben Dank vorab :)

...zur Frage

Excel VBA Button Enable?

Hallo Freunde,

Ich habe einen Button in Excel implementiert, der sichtbar sein soll wenn meine Zelle A1 die Zahl 2 enthält.

Der Code dafür lautet:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
  On Error GoTo ErrHandler
  Dim rngButton1 As Integer
  rngButton1 = A1
  If rngButton1 = 2 Then
  CommandButton1.Enabled = False
  Else
  CommandButton1.Enabled = True
  End If
  Application.EnableEvents = True
Exit Sub
ErrHandler:
Application.EnableEvents = True
End Sub

Der Code funktioniert an und für sich, es kommt zu keiner Fehlermeldung.
Aber der Button bleibt egal was ich einstelle, Sichtbar.

Wo liegt der Fehler?

...zur Frage

Maximale Pfadlänge in Windows und VBA umgehen?

Hallo,

ich benutze folgenden Code in Excel VBA um mir Dateipfad und Dateiname eines Ordners und allen darin enthaltenen Unterordnern aufzulisten.
(Ihr könnt es testen, den Code einfach in ein Modul kopieren, "MainList" ausführen und einen Ordner eurer Wahl auswählen)

Ich habe jetzt das Problem, dass dieser Code alle Dateien überspringt, deren Pfadlänge über 255 Zeichen lang ist. Einige Dateien überschreiten nämlich die 255 Zeichen mit dem angehängten Dateinamen.
Sie liegen aber dennoch ab. Nur liest VBA diese nicht aus. Kann man da was dran machen?

Sub MainList()
'Updateby Extendoffice
Set Folder = Application.FileDialog(msoFileDialogFolderPicker)
If Folder.Show <> -1 Then Exit Sub
xDir = Folder.SelectedItems(1)
Call ListFilesInFolder(xDir, True)
End Sub

Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row + 1
For Each xFile In xFolder.Files
  Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Path
  Application.ActiveSheet.Cells(rowIndex, 2).Formula = xFile.Name
  rowIndex = rowIndex + 1
Next xFile
If xIsSubfolders Then
  For Each xSubFolder In xFolder.SubFolders
    ListFilesInFolder xSubFolder.Path, True
  Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub

Function GetFileOwner(ByVal xPath As String, ByVal xName As String)
Dim xFolder As Object
Dim xFolderItem As Object
Dim xShell As Object
xName = StrConv(xName, vbUnicode)
xPath = StrConv(xPath, vbUnicode)
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.Namespace(StrConv(xPath, vbFromUnicode))
If Not xFolder Is Nothing Then
  Set xFolderItem = xFolder.ParseName(StrConv(xName, vbFromUnicode))
End If
If Not xFolderItem Is Nothing Then
  GetFileOwner = xFolder.GetDetailsOf(xFolderItem, 8)
Else
  GetFileOwner = ""
End If
Set xShell = Nothing
Set xFolder = Nothing
Set xFolderItem = Nothing
End Function

...zur Frage

Excel: Verbessertes Logging mit VBA Makro?

Hallo Zusammen

ich verwende im Moment ein kurzes Makro, um Änderungen in einem Tabellenblatt zu loggen.

Es registriert aber nur einzelne Änderungen, nicht multi-selektion oder Löschen von Spalten. Kann ich das mit separaten Privaten Subs übernehmen?

Und kann ich aufnehmen, was die Target- und "PreVal"-Adresse war (Offset 4+5)

Code:

Dim PreVal
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
PreVal = Target.Value
 
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  
    On Error GoTo 0
    
    If Target.Value <> PreVal Then
        With Sheets(2).Cells(Rows.Count, 1).End(xlUp)
            .Offset(1, 0) = Now
            .Offset(1, 1) = PreVal
            .Offset(1, 2) = Target.Value
            .Offset(1, 3) = Environ("Username")
        End With
    End If
 
End Sub

...zur Frage

Wie kann ich das Rutschen des DIV-Containers verhindern?

Hallo, wie auf dem Foto (schlecht, rechts unten) zu erkennen möchte ich 3 DIV-Container nebeneinander platzieren.Dazu habe ich alle drei in ein großen Container gesteckt. Jedoch "rutscht" das rechte DIV immer nach unten ohne dass ich es möchte oder weiß wieso es das tut...Ich hoffe es kann mir hier geholfen werden!

CSS:

#body {
    background-color: aqua;
    width: 100%;
    height: 100%;
}


#mitte {
    height: inherit;
    max-width: 60%;
    background-color: aliceblue;
}


#links {
    width: 15%;
    height: inherit;
    float: left;
    background-color: brown;
}


#rechts {
    width: 15%;
    height: inherit;
    float: right;
    background-color: blueviolet;
}

Da HTML hier Probleme mit den < und > hat, davon ein Bild im Anhang...

Danke im voraus, Thomas

...zur Frage

VBA UserForm KeyDown Sonderzeichen werden nicht erkannt?

Hallo, ich habe eine Frage zu meinem VBA Code. Und zwar sollen verschiedene Tastatureingaben verschiedene Funktionen triggern. Bei Zahlen, Buchstaben, Plus, Minus, "&"-Zeichen, "!"-Zeichen und einige andere Tasten gehen. "*"-Zeichen, Prozent, "(" und ")" bspw. gehen jedoch NICHT (als KeyCode wird 0 zurückgegeben). Hat jemand eine Ahnung woran das liegt?

Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  handleKeyDown KeyCode, Shift
End Sub

Private Sub handleKeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Dim keyChar As String * 1
  keyChar = Chr(KeyCode)
  MsgBox (KeyCode)
  Select Case keyChar
  Case "0"
    numb0_Click
  Case "1"
    numb1_Click
  '.....
  Case Else
  End Select
  Select Case KeyCode
  Case "187"
    plus_Click
  '....
  Case Else 
  End Select
End Sub

Danke für alle Antworten,

Nicolas

...zur Frage

Wieso unverträgliche Typen bei diesem Code?

Hi, da bin ich wieder. Nun bin ich wieder einen guten Schritt weiter.

Problem: Ich habe geschlossene Textmarker in Word, dessen Inhalt über Excel gefüllt/ersetzt werden soll.

Ich habe folgenden Code:

Public Sub ReSetBookmark(ByVal doc As Object, ByVal TMName As String, ByVal TMInhalt As String)
'Recycling-Textmarke mit übernommenen Werten, geht für alle Textmarken


    Dim bm As Bookmark
    Dim rng As Range
   
    If doc.Bookmarks.Exists(TMName) Then
        Set bm = doc.Bookmarks(TMName)
        Set rng = bm.Range
        rng.Text = TMInhalt
        doc.Bookmarks.Add Name:=TMName, Range:=rng
    End If
   
    Set rng = Nothing
    Set bm = Nothing
   
End Sub

Der Code wurde im Netz mehrfach geposted.

Nur erhalte ich einen Fehler wegen Typenunverträglichkeit in dieser Zeile:

        Set rng = bm.Range

wenn ich aber mit der Maus draufzeige, sehe ich dass der Inhalt dieser Range richtig angezeigt wird: " " (im Bereich der Textmarke ist nur ein Leerzeichen).

Ich verstehe einfach nicht, warum der Code nun stehen bleibt.

Kann bitte jemand helfen?

Dankeschön.

...zur Frage

Fehlermeldung in VBA: Typen unverträglich?

Hallo,

ich kriege eine Fehlermeldung in VBA, finde allerdings keine Lösung, dies zu beheben. Könnt ihr mir helfen?

Sub Berichte()
    Dim Liste As Workbook
    Dim Bericht As Workbook
    Dim Dati As Variant
    
    Set Bericht = ActiveWorkbook
    Dati = Application.GetOpenFilename("Excel-Dateien(*.xl*),*.xl*")
    Set Liste = Workbooks.Open(Filename:=Dati)
    ActiveWorkbook.Sheets("Tabelle1").Columns("A:E").Copy
    
    Windows(Bericht).Activate
    Columns("A:E").Select
    ActiveSheet.Paste

End Sub

...zur Frage

Excel - Speicher-datum in Kopfzeile?

möchte immer das letzte Speicherdatum in der Kopfzeile. Habe bereits mehrere Lösungen gegoogelt, aber funktionieren tun sie nicht. Wo mache ich den Fehler?

Habe folgenden Befehl eingegeben

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim booIsSaved As Boolean
Dim strDatInfo As String
With ThisWorkbook
booIsSaved = .Saved
If .Path <> "" Then
strDatInfo = .BuiltinDocumentProperties("Last save time")
Else
strDatInfo = "noch nicht gespeichert"
End If
ActiveSheet.PageSetup.LeftHeader = "Zuletzt gespeichert: " & strDatInfo
.Saved = booIsSaved
End With
End Sub

Und hier noch einen printscreen. Besten Dank

...zur Frage

Was möchtest Du wissen?

Deine Frage stellen