MakroAnweisung fuer TextStrukturierung

Dieses Thema MakroAnweisung fuer TextStrukturierung im Forum "Microsoft Office Suite" wurde erstellt von grego, 27. März 2005.

Thema: MakroAnweisung fuer TextStrukturierung Hallo und guten Tag... In einem aelteren TextVerarbeitungsProgramm mit dem Namen LotusAmiPro (das ich zur...

  1. Hallo und guten Tag...

    In einem aelteren TextVerarbeitungsProgramm mit dem Namen LotusAmiPro (das ich zur unbedingten DokumenteErStellung benoetige) habe ich einen Hinweis gefunden, dass es in der Anwendung des Programms moeglich waere, ueber \BASIC\ - \Makros\ TexteStrukturen in der Darstellung veraendern zu koenen.

    Leider hab ich ueberhaupt keine Ahnung wie ich es anstellen muesste eine Anweisung zu schreiben die mir hilft einen strukturierten Text in der ZeilenReihenfoge zu stuerzen oder zu spiegeln, das heisst,

    eine Anweisung fuer ein erstes Makro:

    ich markiere im Manuscript einen Text ueber einige Zeilen und durch den MakroBefehl sollte nun die SatzZeilenReihenFolge gestuerzt werden ? die erst oberste Zeile wird zur erst untersten Zeile, die zweit oberste wird zur zweit untersten, die dritt oberste wird zur dritt untersten Zeile usw. ? umstrukturiert,

    eine Anweisung fuer ein zweites Makro:

    ich markiere im Manuscript einen Text ueber einige Zeilen und durch den MakroBefehl sollte nun der Text gespiegelt werden, das heisst ich muss den Satz von rechts nach links anstatt von links nach rechts lesen koennen,

    eine Anweisung fuer ein drittes Makro:

    das Scrollrad der Maus sollte im gesamten Manuscript aktiviert werden koennen um die TextAnsicht auch mit dem Scrollrad abfahren zu koennen.

    Unten habe ich als BasicSprachBeispiel ein Script eingefuegt, das in der Anwendung des Programms zur Verfuegung steht, um einen markierten Text im Schriftgrad erhoehen zu koennen.

    Mir wurde gesagt, dass diese ScriptSprache, aehnlich/BASIC, auch zur Programmierung von OfficeMacros verwendet wuerde.....

    und desshalb versuche ich hier in euerem Forum mein Glueck.

    Code:
     ignorekeyboard(2)
    macfile = GetRunningMacroFile$()-> get the dos file name
    globtot = GetGlobalVarCount()
    menustat = OFF
    if globtot <> 0
     Dim globnames(globtot)
     GetGlobalVarNames(&globnames)
     for i = 1 to globtot-> find the global var
      if (globnames(i) = FontUpStat)
       menustat = ON
       
      endif
     next 
    EndIf
    If menustat = OFF
     AllocGlobalVar(FontUpStat,1)-> first time played, add menus
     DeleteMenuItem(1,&Text, Schrift größer)
     InsertMenuItem(1,&Text, 12,Schrift größer, {MacFile}!bigger(), Vergrößert die Schrift um zwei Punkte)
     
     SetGlobalVar(FontUpStat,ON)
    Endif
     
    call bigger()-> make call to make the font bigger
     
    end function
     
    
    function bigger()
    defstr name, color, size, family
    GetCurFontInfo(&name, &color, &size, &family)-> what is the current font?
    FontChange(Name, 0, Color, (Size  + 40))-> add size to existing size
    end function 
    Ich waere sehr dankbar und froh um jeden Hinweis den ich erhalten koennte,

    mit freuntlichen Gruessen,

    Gregor Thomas.
     
  2. Hallo Grego,

    für dein erstes Problem hab ich dir eine Makro für Word geschrieben. Der sollte unter Ami-Pro auch laufen. Probier es mal aus.
    Code:
    Sub SelektierteParagraphenStuerzen()
      Dim f() As Paragraph, f_cnt As Long, p As Paragraph
      Dim l_start As Long, x As Long
      ReDim f(1 To 1)
      f_cnt = 0
      For Each p In Selection.Paragraphs
        f_cnt = f_cnt + 1
        ReDim Preserve f(1 To f_cnt)
        Set f(f_cnt) = p
      Next
      f(f_cnt).Range.Select
      Selection.Collapse Direction:=wdCollapseEnd
      For x = f_cnt To 1 Step -1
        f(x).Range.Copy
        Selection.Paste
        Selection.Collapse Direction:=wdCollapseStart
      Next
      For x = f_cnt To 1 Step -1
        f(x).Range.Delete
      Next
    End Sub
     
  3. Hallo Grego,

    für Problem Nr2 ist dieser Makro:
    Code:
    Sub SelektierteParagraphenTextrichtungUmdrehen()
      Dim f() As Paragraph, f_cnt As Long, p As Paragraph
      Dim x As Long, y As Long
      Dim s_text As String, s_invers As String
      ReDim f(1 To 1)
      f_cnt = 0
      For Each p In Selection.Paragraphs
        f_cnt = f_cnt + 1
        ReDim Preserve f(1 To f_cnt)
        Set f(f_cnt) = p
      Next
      
      For x = 1 To f_cnt
        s_text = f(x).Range.Text
        s_invers = 
        For y = Len(s_text) - 1 To 1 Step -1
          s_invers = s_invers & Mid(s_text, y, 1)
        Next
        s_invers = s_invers & Right(s_text, 1)
        f(x).Range.Text = s_invers
      Next
    End Sub
    Gruß Matjes  ;)
     
  4. Hallo Matjes,

    rechtherzlichen Dank fuer Deine Scripte, du weisst gar nicht wie lange ich schon suche und wie sehr Du mir damit helfen kannst....

    im AmiPro laufen die Scripte noch nicht, aber das waere auch nicht so wahnsinnig schlimm wenn ich meine Manuscripte ueber Word umstrukturieren muesste, es waere mir auch damit schon sehr sehr geholfen....

    Zu Deinem Script Nr1 -> SelektierteParagraphenStuerzen, ordnet mir dein Makro nur die ganzen Absaetze um, das heisst der erst oberste Absatz wird zum erst untersten, der zweit oberste wird zum zweit unersten usw.....;
    glaubst Du dass es Dir vielleicht moeglich waere, die Saetze selbst, auch im Zeilenumbruch umzustrukturieren....; so dass der Verlauf der Satzstellung im Satzumbruch von unten links nach oben rechts verlaeuft, eigentlich nur umgekehrt zu lesen wie wir es gewohnt sind, anstatt -> von oben links nach unten rechts -> von unten links nach oben rechts....

    Dein zweites Script Nr2 -> SelektierteParagraphenTextrichtungUmdrehen, ist perefekt in der Umstrukturierung, leider aber verliere ich die Formatierung, das heisst es werden farbig markierte Worte im Satz oder verschieden grosse Scriftgrade in der Ausgabe nicht mehr widergeben....glaubst Du, Du koenntest es vielleich noch umschreiben...?

    Hoffentlich bitte ich Dich nicht um zu viel, aber wenn Du mir vielleicht weiterhelfen moechtest waere ich sehr froh....

    danke vorerst, Grego.

    Ns. Im ersten Script Nr1 muesste die Formatierung des Manuscriptes gleichfalls beibehalten werden ( funktioniert so wie es jetzt ist auch...).
     
  5. Hi Grego,

    erstmal deine gewünschte Korrektur zu script2.
    Ist etwas langsam, da es zeichenweise kopiert.

    Gruß Matjes :)
    Code:
    Sub SelektierteParagraphenTextrichtungUmdrehen()
      Dim f() As Paragraph, f_cnt As Long
      Dim f2() As Paragraph, f2_cnt As Long
      Dim x As Long, p As Paragraph
      Dim l_start As Long, l_end As Long
      Dim b_SmartCutPaste
    
      ReDim f(1 To 1)
      f_cnt = 0
     ->alle selekiterten Paragraphen merken
      For Each p In Selection.Paragraphs
        f_cnt = f_cnt + 1
        ReDim Preserve f(1 To f_cnt)
        Set f(f_cnt) = p
      Next
      
     ->Paragraphen kopieren und kopierte Paragraphenmerken
      ReDim f2(1 To 1): f2_cnt = 0
      For x = f_cnt To 1 Step -1
        f(f_cnt).Range.Select
        Selection.Collapse Direction:=wdCollapseEnd
        f(x).Range.Copy
        Selection.Paste
        Selection.Move Unit:=wdParagraph, Count:=-1
        f2_cnt = f2_cnt + 1
        ReDim Preserve f2(1 To f2_cnt)
        Set f2(f2_cnt) = Selection.Paragraphs(1)
      Next
      
     ->Wichtig:automatischer Leerzeichenausgleich bei Cut and Paste abschalten
     ->sonst kommen die Leerzeichen nicht mit
      b_SmartCutPaste = Options.SmartCutPaste
      Options.SmartCutPaste = False
      
     ->Für alle Paragraphen f() und in umgekehrter Richtung f2()
      For x = 1 To f_cnt
        
       ->QuellParagraph ohne Endmarke - Anfang und Ende
        f(x).Range.Select
        l_start = Selection.Start
        l_end = Selection.End - 1
        
       ->ZielParagraph - Text ohne Endmarke löschen
        f2(f2_cnt - x + 1).Range.Select
        Selection.MoveEnd Unit:=wdCharacter, Count:=-1
        Selection.Delete
        
       ->Zeichen des Quellparagraphen in Zielparagraph
       ->in umgekehrter Reihenfolge kopieren
       ->dabei wird Formatierung erhalten
        Do While l_start < l_end
          ActiveDocument.Range(Start:=l_end - 1, End:=l_end).Copy
          Selection.Paste
          l_end = l_end - 1
        Loop
      Next
      
     ->Die QuellParagraphen löschen
      For x = f_cnt To 1 Step -1
        f(x).Range.Delete
      Next
     ->automatischer Leerzeichenausgleich restaurieren
      Options.SmartCutPaste = b_SmartCutPaste
      
    End Sub
     
  6. So jetzt nochmal die leicht modifizierte Version für script 2 und für script 1 die Korrektur.

    Gruß Matjes :)
    Code:
    Sub SelektierteParagraphenStuerzen()
      Dim f() As Paragraph, f_cnt As Long, p As Paragraph
      Dim l_Start As Long, x As Long, y As Long, l_AnzSaetze As Long
      Dim l_StartOld As Long, l_EndOld As Long
      Dim b_SmartCutPaste As Boolean
      
      
     ->Start- und End-Position auf Paragraphengrenze erweitern und merken
      l_StartOld = Selection.Paragraphs(1).Range.Start
      l_EndOld = Selection.Paragraphs(Selection.Paragraphs.Count).Range.End
      ActiveDocument.Range(Start:=l_StartOld, End:=l_EndOld).Select
      
      
     ->*** ertmal die Paragraphen stürzen
      f_cnt = 0: ReDim f(1 To 1)
     ->selektierte Paragraphen merken
      For Each p In Selection.Paragraphs
        f_cnt = f_cnt + 1
        ReDim Preserve f(1 To f_cnt)
        Set f(f_cnt) = p
      Next
     ->Schreibmarke nach dem letzten markierten
     ->Paragraphen setzen und Paragraphen in umgekehrter
     ->Reihenfolge kopieren
      f(f_cnt).Range.Select
      Selection.Collapse Direction:=wdCollapseEnd
      For x = f_cnt To 1 Step -1
        f(x).Range.Copy
        Selection.Paste
        Selection.Collapse Direction:=wdCollapseStart
      Next
     ->ursprünglche Paragraphen löschen
      For x = f_cnt To 1 Step -1: f(x).Range.Delete: Next
      
     ->*** Selektion der Paragraphen restaurieren
      ActiveDocument.Range(Start:=l_StartOld, End:=l_EndOld).Select
      
     ->*** Paragraphen erneut merken
      f_cnt = 0: ReDim f(1 To 1)
     ->selektierte Paragraphen merken
      For Each p In Selection.Paragraphs
        f_cnt = f_cnt + 1
        ReDim Preserve f(1 To f_cnt)
        Set f(f_cnt) = p
      Next
     ->Paragraphen in umgekehrter Reihenfolge
     ->abarbeiten
      
     ->Wichtig:automatischer Leerzeichenausgleich bei Cut and Paste abschalten
     ->sonst kommen die Leerzeichen nicht mit
      b_SmartCutPaste = Options.SmartCutPaste
      Options.SmartCutPaste = False
      For x = f_cnt To 1 Step -1
        l_AnzSaetze = f(x).Range.Sentences.Count
        For y = 2 To l_AnzSaetze
          f(x).Range.Sentences(y).Select
          If y = l_AnzSaetze Then
           ->nicht die Absatzmarke mitnehmen
            Selection.MoveEnd Unit:=wdCharacter, Count:=-1
          End If
          Selection.Cut
          f(x).Range.Select
          Selection.Collapse Direction:=wdCollapseStart
          Selection.Paste
          If y = l_AnzSaetze Then
           ->Noch ein Leerzeichen einfügen,
           ->wenn keins vorhanden ist
           ->(ursprünglich war dann vor der
           ->Absatzmarke keins)
            Selection.InsertAfter  
            Selection.MoveLeft Unit:=wdCharacter, Count:=2
            Selection.Expand Unit:=wdCharacter
            If Selection.Text =   Then Selection.Text = 
          End If
        Next
      Next
     ->automatischer Leerzeichenausgleich restaurieren
      Options.SmartCutPaste = b_SmartCutPaste
    End Sub
    Sub SelektierteParagraphenTextrichtungUmdrehen()
      Dim f() As Paragraph, f_cnt As Long
      Dim f2() As Paragraph, f2_cnt As Long
      Dim x As Long, y As Long, p As Paragraph
      Dim b_SmartCutPaste, l_AnzCharacter As Long
    
      ReDim f(1 To 1)
      f_cnt = 0
     ->alle selekiterten Paragraphen merken
      For Each p In Selection.Paragraphs
        f_cnt = f_cnt + 1
        ReDim Preserve f(1 To f_cnt)
        Set f(f_cnt) = p
      Next
      
     ->Paragraphen kopieren und kopierte Paragraphenmerken
      ReDim f2(1 To 1): f2_cnt = 0
      For x = f_cnt To 1 Step -1
        f(f_cnt).Range.Select
        Selection.Collapse Direction:=wdCollapseEnd
        f(x).Range.Copy
        Selection.Paste
        Selection.Move Unit:=wdParagraph, Count:=-1
        f2_cnt = f2_cnt + 1
        ReDim Preserve f2(1 To f2_cnt)
        Set f2(f2_cnt) = Selection.Paragraphs(1)
      Next
      
     ->Wichtig:automatischer Leerzeichenausgleich bei Cut and Paste abschalten
     ->sonst kommen die Leerzeichen nicht mit
      b_SmartCutPaste = Options.SmartCutPaste
      Options.SmartCutPaste = False
      
     ->Für alle Paragraphen f() und in umgekehrter Richtung f2()
      For x = 1 To f_cnt
        
       ->QuellParagraph ohne Endmarke - Anzahl Character
        l_AnzCharacter = f(x).Range.Characters.Count - 1
        
       ->ZielParagraph - Text ohne Endmarke löschen
        f2(f2_cnt - x + 1).Range.Select
        Selection.MoveEnd Unit:=wdCharacter, Count:=-1
        Selection.Delete
        
       ->Zeichen des Quellparagraphen in Zielparagraph
       ->in umgekehrter Reihenfolge kopieren
       ->dabei wird Formatierung erhalten
        For y = l_AnzCharacter To 1 Step -1
          f(x).Range.Characters(y).Copy
          Selection.Paste
        Next
      Next
      
     ->Die QuellParagraphen löschen
      For x = f_cnt To 1 Step -1
        f(x).Range.Delete
      Next
     ->automatischer Leerzeichenausgleich restaurieren
      Options.SmartCutPaste = b_SmartCutPaste
      
    End Sub
     
  7. Hallo Matjes,

    nochmals rechtvielen Dank fuer Deine Muehe und Deine Scripte.....

    Das Script Nr.2 Sub SelektierteParagraphenTextrichtungUmdrehen laeuft perfekt, ein bischen langsam, wie Du gesagt hast, aber ich spar mir damit unbeschreiblich viel Arbeit und Zeit, nochmals vielen vielen Dank.....

    das Script Nr.1 Sub SelektierteParagraphenStuerzen lauft leider nicht ganz richtig, kurz erscheint der Text und dann wird er nochmals neu aber leider durcheinander strukturieret.....

    koenntest Du vielleicht nocheinmal nachsehen bitte....?

    Danke, gruss Grego.
     
  8. Hi grego,

    bei der Funktion gibt es Schwiergkeiten, je nachdem, wie deine Sätze aussehen. Wenn Du in deinen Sätzen z.B.->Dies ist der 1. Satz.' schreibst, funktioniert die Word-Satzerkennung nicht. Word macht dann zwei Sätze daraus->'Dies ist der 1.' und->Satz.'. Richtig erkannt wird in diesem Fall->Dies ist der erste Satz.'
    Da mußt Du selbst schauen, wie Du die Sätze erkennen kannst.

    Du kannst sehen, wie der Makro arbeitet, wenn Du nach der Zeile
    Code:
     f(x).Range.Sentences(y).Select
    einen Haltepunkt setzt. Dann siehst Du bei jedem Durchlauf,was der Makro (bzw. Word) für den nächsten Satz hält.

    Gruß Matjes :)
     
  9. Hallo Matjes,

    ich hab gefunden was Du meinst und ich muss nur die bestimmten Zeilen mit einem Umbruch kennzeichnen und dann gehts..... :) ......ich weiss nicht was ich noch sagen soll, Deine Hilfe ist fuer mich ist unsagbar gross, nochmals rechtherzlichen und vielen vielen Dank....

    Gruss Grego.
     
Die Seite wird geladen...

MakroAnweisung fuer TextStrukturierung - Ähnliche Themen

Forum Datum
Fuer Windows 8 mein .outlook.de Konto aendern Windows 8 Forum 28. Aug. 2014
Internetzugang fuer bestimmte Benutzer einschraenken Windows XP Forum 6. Apr. 2011
Praesentation fuer Open Source Software Windows XP Forum 2. Apr. 2011
Gewinnspiel auf FuerFrei.de gefunden: Samsung S I9000 Windows XP Forum 29. Sep. 2010
Keine Rechte mehr fuer Domaenen-User auf lokale Programme Windows XP Forum 11. März 2010