Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

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, 1804 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 ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Ähnliche Inhalte
VB for Applications
gelöst VBA-Makro verschwindet nach Speichern (5)

Frage von lupi1989 zum Thema VB for Applications ...

Microsoft Office
Registerkarte in Excel automatisch färben (10)

Frage von ralfkausk zum Thema Microsoft Office ...

Windows Server
Jnlp Endungen mit Java automatisch verknüpfen über GPO (10)

Frage von staybb zum Thema Windows Server ...

Heiß diskutierte Inhalte
Windows Server
DHCP Server switchen (25)

Frage von M.Marz zum Thema Windows Server ...

SAN, NAS, DAS
gelöst HP-Proliant Microserver Betriebssystem (14)

Frage von Yannosch zum Thema SAN, NAS, DAS ...

Grafikkarten & Monitore
Win 10 Grafikkarte Crash von Software? (13)

Frage von Marabunta zum Thema Grafikkarten & Monitore ...

Windows 7
Verteillösung für IT-Raum benötigt (12)

Frage von TheM-Man zum Thema Windows 7 ...