Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Word2003Makro Dokument automatisch in neuem Unterordner speichern und ausdrucken

Frage Microsoft Microsoft Office

Mitglied: Office-Explorer

Office-Explorer (Level 1) - Jetzt verbinden

05.03.2013, aktualisiert 07.03.2013, 1874 Aufrufe, 6 Kommentare

Hallo,

bin neu hier im Forum und "Laie" im VBA Programmieren. Es wäre nett, wenn mich jemand unterstützen könnte, die noch offenen Fragen zu klären.
Vielen Dank schon einmal im Voraus.

Wir sind eine Beratungsstelle, in der wir Gesprächsprotokolle mit Word2003 erstellen, die in zwei Versionen auf einem Serverlaufwerk abgespeichert werden sollen (1. Verlauf, 2. mit Anhang persönliche Notizen). Dies habe ich versucht über Makros in Word 2003 zu lösen.
Im ersten Makro wird das Worddokument, nach Abfrage des Speicheror-tes und –Namens abgespeichert. Dann wird ein Teil des Textes kopiert und unten angehängt, so dass man seine persönlichen Notizen anhängen kann. Dieses erste Makro (s. Anhang) funktioniert gut, bis darauf, dass der zuerst vorgeschlagene Speicherort nicht der jeweilige Desktop des jeweils angemeldeten Benutzers ist.

_________________________________________________
Sub PersönlichesProtokoll()
'
' PersönlichesProtokoll Makro
' Makro aufgezeichnet am 06.02.2013 von T.Mueller
'
Dim dialog As Object
Dim pfad As String
Dim datei As String
pfad = "B:\8. FALL - VERWALTUNG\5. LAUFENDE FÄLLE\Gesprächsprotokoll"
Set dialog = Application.FileDialog(msoFileDialogSaveAs)
With dialog
.InitialFileName = pfad
.Show
End With
If dialog <> False Then dialog.Execute
Selection.InsertBreak Type:=wdPageBreak
Selection.InsertBreak Type:=wdSectionBreakNextPage
Selection.HomeKey Unit:=wdStory
Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend
Selection.Copy
Selection.EndKey Unit:=wdStory
Selection.PasteAndFormat (wdPasteDefault)
Selection.TypeText Text:="Persönliche Notizen:"
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=21, Extend:=wdExtend
Selection.Font.Bold = wdToggle
With Selection.ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpace1pt5
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = True
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.AutoAdjustRightIndent = True
.DisableLineHeightGrid = False
.FarEastLineBreakControl = True
.WordWrap = True
.HangingPunctuation = True
.HalfWidthPunctuationOnTopOfLine = False
.AddSpaceBetweenFarEastAndAlpha = True
.AddSpaceBetweenFarEastAndDigit = True
.BaseLineAlignment = wdBaselineAlignAuto
End With
Selection.MoveDown Unit:=wdLine, Count:=1
End Sub
_________________________________________________

Im zweiten Makro soll nun die Datei erneut abgespeichert werden und anschließend in ganzer Länge ausgedruckt werden. Auch das habe ich per Makro hinbekommen. Jetzt aber die Besonderheiten:
Der Dateiname soll gleich bleiben, aber in einem neu zu erstellenden Un-terordner, mit dem pauschalen Namen "PN" (für persönliche Notizen), in-nerhalb des bestehenden Ordners, abgespeichert werden. Zum Teil be-steht der PN Ordner schon (wenn zuvor Protokolle erstellt wurden), zum Teil auch nicht (erstes Protokoll). Der Ordner PN sollte also nur dann erstellt werden, wenn er noch nicht besteht. Nach dem Abspeichern soll die ge-samte Datei automatisch ausgedruckt werden.
Meine Schwierigkeit besteht nun darin, erstens den bestehenden Pfad zum Abspeichern auszulesen, zweitens zu sondieren, ob ein PN Ordner be-steht, drittens, diesen bei Bedarf einzufügen und dann die Datei dort ab-zuspeichern. Zudem hat sich beim Probieren oftmals gezeigt, dass im zwei-ten Makro beim Abspeichern als „Speicherort“ die Dokumentvorlagenauswahl angezeigt wurde und nicht die Ordnerstruktur für die Protokolle.

_________________________________________________
Sub ProtokollAusdrucken()
'
' ProtokollAusdrucken Makro
' Makro erstellt am 26.02.2013 von T.Mueller
'
Dim dialog As Object
Dim pfad As String
Dim datei As String
dname = ActiveDocument.Name
MsgBox (dname)
pfad = "B:\8. FALL - VERWALTUNG\5. LAUFENDE FÄLLE\Gesprächsprotokoll"
Set dialog = Application.FileDialog(msoFileDialogSaveAs)
With dialog
.InitialFileName = pfad
.Show
End With
Application.PrintOut Filename:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
End Sub

_________________________________________________

Soweit die Beschreibung des Problems. Kann jemand weiterhelfen und mir zeigen, wie ich die Makros programmieren kann. Vielen Dank schon ein-mal im Voraus.
Mitglied: colinardo
05.03.2013, aktualisiert um 10:38 Uhr
Hi Office-Explorer, Willkommen im Forum,

Zu deinem ersten Problem:
Zitat von Office-Explorer:
Dieses erste Makro (s.
Anhang) funktioniert gut, bis darauf, dass der zuerst vorgeschlagene Speicherort nicht der jeweilige Desktop des jeweils
angemeldeten Benutzers ist.
Dein Pfad zu einem Ordner sollte mit einem Backslash(\} enden dann sollte der Dialog den Ordner richtig übernehmen.
01.
pfad = "B:\8. FALL - VERWALTUNG\5. LAUFENDE FÄLLE\Gesprächsprotokoll\"
Für dein zweites Problem sollte dir folgender Code weiterhelfen:
01.
'Pfad des aktuellen Dokuments 
02.
mainfolder = ActiveDocument.Path 
03.
'Pfad zum Subfolder "PN" 
04.
pnSubFolder = mainfolder & "\PN" 
05.
If Dir(subfolder, vbDirectory) <> vbNullString Then 
06.
   'Ordner PN existiert 
07.
Else 
08.
   'Ordner PN existiert noch nicht, also erstelle Ihn 
09.
   MkDir (subfolder) 
10.
End If
p.s. Bitte poste deinen Code der Übersicht halber mit Code-Tags, Danke.
http://www.administrator.de/faq/20

Grüße Uwe
Bitte warten ..
Mitglied: Office-Explorer
05.03.2013 um 10:58 Uhr
Hallo Colinardo,

Danke für die schnelle Antwort. Ich werde es mal ausprobieren. Beim Posten habe ich schon nach der Formatierung gesucht und werde es beim nächsten mal machen. Leider kann ich heute nicht mehr an der Vorlage arbeiten, melde mich aber wieder, - hoffentlich mit Erfolg.

Grüße
Thomas
Bitte warten ..
Mitglied: Office-Explorer
06.03.2013 um 17:34 Uhr
Hallo nochmals,

danke für die schnelle Antwort. Ich habe verschiedene Varianten die Befehlszeilen einzufügen, ausprobiert. Leider fehlt mir hier das Fachwissen und ich komme nicht weiter. Könnte mir jemand sagen, wie die einzelnen Befehlzeilen an die richtige Stelle gesetzt werden? Ziel: Dateiname beibehalten, Unterordner 'PN' erstellen, wenn nicht vorhanden, ansonsten darin abspeichern. Nachfolgend Dokument ausdrucken, aber das klappt ja, so dass ich das einfach hinten anhängen würde. Zur Übersicht nochmals mein Code.

Vielen Dank an Colinardo und all' die anderen fleißigen Helfer,

Thomas

01.
 Sub ProtokollAusdrucken() 
02.
03.
' ProtokollAusdrucken Makro 
04.
' Makro erstellt am 26.02.2013 von T.Mueller 
05.
06.
Dim dialog As Object 
07.
Dim pfad As String 
08.
Dim datei As String 
09.
    dname = ActiveDocument.Name 
10.
    MsgBox (dname) 
11.
pfad = "B:\8. FALL - VERWALTUNG\5. LAUFENDE FÄLLE\Gesprächsprotokoll" 
12.
Set dialog = Application.FileDialog(msoFileDialogSaveAs) 
13.
With dialog 
14.
.InitialFileName = pfad 
15.
.Show 
16.
End With 
17.
        Application.PrintOut Filename:="", Range:=wdPrintAllDocument, Item:= _ 
18.
        wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _ 
19.
        ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _ 
20.
        False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _ 
21.
        PrintZoomPaperHeight:=0 
22.
End Sub
Bitte warten ..
Mitglied: colinardo
06.03.2013 um 20:36 Uhr
01.
 Sub ProtokollAusdrucken() 
02.
 
03.
Dim dialog As Object 
04.
Dim pfad As String 
05.
Dim datei As String 
06.
dname = ActiveDocument.Name 
07.
 
08.
'Pfad des aktuellen Dokuments 
09.
mainfolder = ActiveDocument.Path 
10.
'Pfad zum Subfolder "PN" 
11.
pnSubFolder = mainfolder & "\PN" 
12.
If Dir(pnSubFolder, vbDirectory) = vbNullString Then 
13.
   MkDir (pnSubFolder) 
14.
End If 
15.
ActiveDocument.SaveAs2 FileName:=pnSubFolder & "\" & dname 
16.
 
17.
        Application.PrintOut Filename:="", Range:=wdPrintAllDocument, Item:= _ 
18.
        wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _ 
19.
        ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _ 
20.
        False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _ 
21.
        PrintZoomPaperHeight:=0 
22.
End Sub
Bitte warten ..
Mitglied: Office-Explorer
07.03.2013 um 10:22 Uhr
Hallo Colinardo,

nochmals Danke für dein Bemühen. Es klappt alles Bestens. Eine tiefe Verbeugung für soviel Unterstützung,

Thomas
Bitte warten ..
Mitglied: colinardo
07.03.2013 um 10:24 Uhr
Keine Ursache...
Bitte Beitrag noch als gelöst markieren. Danke.

Grüße Uwe
Bitte warten ..
Ähnliche Inhalte
Windows 7
Eigene Dokumente auf ein anderes Netzlaufwerk speichern
Frage von uridium69Windows 79 Kommentare

Hallo allerseits Ich habe eine Anwenderin, deren Benutzerprofil bei 16 GB liegt. Dieses wird auf der "Profilpartition" des Servers ...

E-Mail
E-Mailanhänge automatisch ausdrucken
Frage von HeinrichME-Mail2 Kommentare

Hallo zusammen, wir haben seit einigen Tagen das Problem, dass die E-Mailanhänge nicht mehr automatisch ausgedruckt werden. Seit her ...

VB for Applications
Excel Dokument als PDF speichern
gelöst Frage von TIM589VB for Applications2 Kommentare

Ich habe mir ein kleines Rechnungsprogramm gebastelt und würde das ganze am Ende als PDF automatisch abspeichern lassen. Leider ...

Microsoft Office
Aktuelles Tabellenblatt automatisch ausdrucken mit vbs
gelöst Frage von SpacewonderMicrosoft Office2 Kommentare

Hallo das Thema war glaube ich schon mal hier besprochen worden. Doch die richtige Antwort war so richtig nicht ...

Neue Wissensbeiträge
Sicherheit

Blackberry stirbt - Keine Updates für Priv mehr

Tipp von certifiedit.net vor 20 MinutenSicherheit

Blackberry wird zu einer 08/15 Firma und geht wohl mehr und mehr den Weg, den HTC schon ging. Von ...

Windows 10

Autsch: Microsoft bündelt Windows 10 mit unsicherer Passwort-Manager-App

Tipp von kgborn vor 2 TagenWindows 107 Kommentare

Unter Microsofts Windows 10 haben Endbenutzer keine Kontrolle mehr, was Microsoft an Apps auf dem Betriebssystem installiert (die Windows ...

Sicherheits-Tools

Achtung: Sicherheitslücke im FortiClient VPN-Client

Tipp von kgborn vor 2 TagenSicherheits-Tools

Ich weiß nicht, wie häufig die NextGeneration Endpoint Protection-Lösung von Fortinet in deutschen Unternehmen eingesetzt wird. An dieser Stelle ...

Internet

USA: Die FCC schaff die Netzneutralität ab

Information von Frank vor 2 TagenInternet5 Kommentare

Jetzt beschädigt US-Präsident Donald Trump auch noch das Internet. Der neu eingesetzte FCC-Chef Ajit Pai ist bekannter Gegner einer ...

Heiß diskutierte Inhalte
Batch & Shell
Kann man mit einer .txt Datei eine .bat Datei öffnen?
gelöst Frage von HelloWorldBatch & Shell20 Kommentare

Wie schon im Titel beschrieben würde ich gerne durch einfaches klicken auf eine Text oder Word Datei eine Batch ...

LAN, WAN, Wireless
WLAN Reichweite erhöhen mit neuer Antenne
gelöst Frage von gdconsultLAN, WAN, Wireless10 Kommentare

Hallo, ich besitze einen TL-WN722N USB-WLAN Dongle mit einer richtigen Antenne. Ich frage mich jetzt ob man die Reichweite ...

Router & Routing
Wieso kann ich den UPD 7000-9000 nicht freigeben?
Frage von Jayk0bRouter & Routing8 Kommentare

Router: Telekom W 723V Ports: UDP 7000-9000 Können nicht frei gegeben werden. Benutzgrund: Rocket League 7000 – 9000 UDP ...

Router & Routing
Fritzbox Gastnetz - exposed Host - zur Sophos IPTV
Frage von medikopterRouter & Routing8 Kommentare

Hallo zusammen, ich habe eine Frage bezüglich des Fritz box Gastzugangs an einer Sophos UTM Home. An liebsten wäre ...