דילוג לתוכן
  • חוקי הפורום
  • פופולרי
  • לא נפתר
  • משתמשים
  • חיפוש גוגל בפורום
  • צור קשר
עיצובים
  • Light
  • Cerulean
  • Cosmo
  • Flatly
  • Journal
  • Litera
  • Lumen
  • Lux
  • Materia
  • Minty
  • Morph
  • Pulse
  • Sandstone
  • Simplex
  • Sketchy
  • Spacelab
  • United
  • Yeti
  • Zephyr
  • Dark
  • Cyborg
  • Darkly
  • Quartz
  • Slate
  • Solar
  • Superhero
  • Vapor

  • ברירת מחדל (ללא עיצוב (ברירת מחדל))
  • ללא עיצוב (ברירת מחדל)
כיווץ
מתמחים טופ
  1. דף הבית
  2. תוכנות
  3. יישומי אופיס
  4. וורד
  5. עזרה הדדית - וורד
  6. שיתוף | אינצקלופדיה שיתופית עבור קודים של מאקרו - איך עושים את....

שיתוף | אינצקלופדיה שיתופית עבור קודים של מאקרו - איך עושים את....

מתוזמן נעוץ נעול הועבר עזרה הדדית - וורד
50 פוסטים 6 כותבים 1.7k צפיות 6 עוקבים
  • מהישן לחדש
  • מהחדש לישן
  • הכי הרבה הצבעות
תגובה
  • תגובה כנושא
התחברו כדי לפרסם תגובה
נושא זה נמחק. רק משתמשים עם הרשאות מתאימות יוכלו לצפות בו.
  • P pcinfogmach

    @דאנציג
    נראה לי שיש לו קובץ תומך שהיה חסר נסה עכשיו

    ד מנותק
    ד מנותק
    דאנציג
    כתב ב נערך לאחרונה על ידי
    #35

    @pcinfogmach
    את הקובץ עם הסיומת FRX ויז'ואל בייסיק לא נותן להוסיף עם השגיאה הנ"ל.
    הקובץ השני מוסיף את זה:
    11b1ab36-29ef-40a4-84ee-151bf0fefb3d-image.png

    P תגובה 1 תגובה אחרונה
    0
    • ד דאנציג

      @pcinfogmach
      את הקובץ עם הסיומת FRX ויז'ואל בייסיק לא נותן להוסיף עם השגיאה הנ"ל.
      הקובץ השני מוסיף את זה:
      11b1ab36-29ef-40a4-84ee-151bf0fefb3d-image.png

      P מנותק
      P מנותק
      pcinfogmach
      מדריכים
      כתב ב נערך לאחרונה על ידי
      #36

      @דאנציג
      מצויין כמו שאמרתי ה- frx לא אמור להיות מותקן הוא רק קובץ תומך

      ד תגובה 1 תגובה אחרונה
      0
      • P pcinfogmach

        @דאנציג
        מצויין כמו שאמרתי ה- frx לא אמור להיות מותקן הוא רק קובץ תומך

        ד מנותק
        ד מנותק
        דאנציג
        כתב ב נערך לאחרונה על ידי דאנציג
        #37

        @pcinfogmach והיכן הוא אמור להיות?
        בSTARTUP, או בTemplates?
        אגב, זה בדיוק הקובץ של הקטנת והגדלת סוגריים של ניקיוזר, אך אם אני לא נותן לו את פקודת המאקרו, כיצד הוא יפעל?

        P תגובה 1 תגובה אחרונה
        0
        • ד דאנציג

          @pcinfogmach והיכן הוא אמור להיות?
          בSTARTUP, או בTemplates?
          אגב, זה בדיוק הקובץ של הקטנת והגדלת סוגריים של ניקיוזר, אך אם אני לא נותן לו את פקודת המאקרו, כיצד הוא יפעל?

          P מנותק
          P מנותק
          pcinfogmach
          מדריכים
          כתב ב נערך לאחרונה על ידי pcinfogmach
          #38

          @דאנציג כתב בשיתוף | אינצקלופדיה שיתופית עבור קודים של מאקרו - איך עושים את....:

          @pcinfogmach והיכן הוא אמור להיות?
          בSTARTUP, או בTemplates?

          אם אתה רוצה שיאתחל עם וורד אז בstartup או פשוט תוסיף אותו לתבנית נורמל.

          אגב, זה בדיוק הקובץ של הקטנת והגדלת סוגריים של ניקיוזר,

          זה דומה אבל לא בדיוק השמטתי חלק מהאפשרויות והוספתי פונקציות ועשיתי קוד חדש, יותר פשוט ונקי.

          אך אם אני לא נותן לו את פקודת המאקרו, כיצד הוא יפעל?

          צודק 🙂
          היה עוד בעיה שתוקנה עכשיו עם השם של היוזרפורם

          ולהוסיף בתוך מודול רגיל קוד כזה

          Sub Parenthesis()
          MyParenthesis.Show
          End Sub
          
          תגובה 1 תגובה אחרונה
          0
          • P מנותק
            P מנותק
            pcinfogmach
            מדריכים
            כתב ב נערך לאחרונה על ידי pcinfogmach
            #39

            הגדל והקטן רווחים בין מילים בפיסקאות שנבחרו
            עריכה: הקוד שופץ ונערך מחדש על פי ההצעה של @מאקרו
            עריכה2: הקוד שימושי ליישור טורים ,אם חסר שורה בין הטורים אפשר כך להוסיף שורה בלי שיורגש...

            Option Explicit
            Sub הגדל_רווחים_בין_מילים()
                Dim rng, para, spaceRange As Range, i As Integer
                
                Set rng = Selection.Range
                
                'loop throgh pragraphs
                For i = 1 To rng.Paragraphs.Count
                Set para = rng.Paragraphs(i).Range
                Set spaceRange = para.Duplicate
                
                ' Loop through each space in the selected paragraph
                Do While spaceRange.InRange(para)
                    spaceRange.MoveStartUntil " " ' Move to the next space
                        If spaceRange.InRange(para) Then _
                            spaceRange.Characters(1).Font.Spacing = spaceRange.Characters(1).Font.Spacing + 1
                               spaceRange.MoveStart unit:=wdCharacter, Count:=1 ' Move to the next character
                Loop
                
                Next i
                
            End Sub
            
            
            Sub הקטן_רווחים_בין_מילים()
                Dim rng, para, spaceRange As Range, i As Integer
                
                Set rng = Selection.Range
                
                'loop throgh pragraphs
                For i = 1 To rng.Paragraphs.Count
                Set para = rng.Paragraphs(i).Range
                Set spaceRange = para.Duplicate
                
                ' Loop through each space in the selected paragraph
                Do While spaceRange.InRange(para)
                    spaceRange.MoveStartUntil " " ' Move to the next space
                        If spaceRange.InRange(para) Then _
                            spaceRange.Characters(1).Font.Spacing = spaceRange.Characters(1).Font.Spacing - 1
                               spaceRange.MoveStart unit:=wdCharacter, Count:=1 ' Move to the next character
                Loop
                
                Next i
                
            End Sub
            
            

            עריכה 3:
            והנה קוד בשיטה אחרת לפי ההצעה של @menajemmendel קוד זה נערך על ידי ושופץ בעזרת @מאקרו

            Sub ChangeSpacing()
            Dim myrange As Range, orange As Range
            Set myrange = Selection.Range
            myrange.SetRange Selection.Paragraphs.First.Range.Start, Selection.Paragraphs.Last.Range.End
            Set orange = ActiveDocument.Range(myrange.Start, myrange.End)
            
            With orange
            .Collapse
            .MoveUntil cset:=" "
            .SetRange Start:=.Start, End:=.Start + 1
            .Select
            End With
            
            Dim c As Font, rslt As Integer
            Set c = Selection.Font
            rslt = c.Spacing + 1
            
            With myrange.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Replacement.Font.Spacing = rslt
            .Text = " "
            .Replacement.Text = "^&"
            .Forward = False
            .Wrap = wdFindStop
            .Format = True
            End With
            myrange.Find.Execute Replace:=wdReplaceAll
            End Sub
            
            
            menajemmendelM תגובה 1 תגובה אחרונה
            2
            • P מנותק
              P מנותק
              pcinfogmach
              מדריכים
              כתב ב נערך לאחרונה על ידי
              #40

              הסרת כל הרווחים בטקסט שסומן

              Sub DeleteSpacesInParagraph()
                  Dim rng As Range
                  
                  ' Set the range to the current paragraph
                  Set rng = Selection.Range
                  
                  ' Remove all spaces
                  rng.text = Replace(rng.text, " ", "")
                  
              End Sub
              
              
              תגובה 1 תגובה אחרונה
              0
              • P pcinfogmach

                הגדל והקטן רווחים בין מילים בפיסקאות שנבחרו
                עריכה: הקוד שופץ ונערך מחדש על פי ההצעה של @מאקרו
                עריכה2: הקוד שימושי ליישור טורים ,אם חסר שורה בין הטורים אפשר כך להוסיף שורה בלי שיורגש...

                Option Explicit
                Sub הגדל_רווחים_בין_מילים()
                    Dim rng, para, spaceRange As Range, i As Integer
                    
                    Set rng = Selection.Range
                    
                    'loop throgh pragraphs
                    For i = 1 To rng.Paragraphs.Count
                    Set para = rng.Paragraphs(i).Range
                    Set spaceRange = para.Duplicate
                    
                    ' Loop through each space in the selected paragraph
                    Do While spaceRange.InRange(para)
                        spaceRange.MoveStartUntil " " ' Move to the next space
                            If spaceRange.InRange(para) Then _
                                spaceRange.Characters(1).Font.Spacing = spaceRange.Characters(1).Font.Spacing + 1
                                   spaceRange.MoveStart unit:=wdCharacter, Count:=1 ' Move to the next character
                    Loop
                    
                    Next i
                    
                End Sub
                
                
                Sub הקטן_רווחים_בין_מילים()
                    Dim rng, para, spaceRange As Range, i As Integer
                    
                    Set rng = Selection.Range
                    
                    'loop throgh pragraphs
                    For i = 1 To rng.Paragraphs.Count
                    Set para = rng.Paragraphs(i).Range
                    Set spaceRange = para.Duplicate
                    
                    ' Loop through each space in the selected paragraph
                    Do While spaceRange.InRange(para)
                        spaceRange.MoveStartUntil " " ' Move to the next space
                            If spaceRange.InRange(para) Then _
                                spaceRange.Characters(1).Font.Spacing = spaceRange.Characters(1).Font.Spacing - 1
                                   spaceRange.MoveStart unit:=wdCharacter, Count:=1 ' Move to the next character
                    Loop
                    
                    Next i
                    
                End Sub
                
                

                עריכה 3:
                והנה קוד בשיטה אחרת לפי ההצעה של @menajemmendel קוד זה נערך על ידי ושופץ בעזרת @מאקרו

                Sub ChangeSpacing()
                Dim myrange As Range, orange As Range
                Set myrange = Selection.Range
                myrange.SetRange Selection.Paragraphs.First.Range.Start, Selection.Paragraphs.Last.Range.End
                Set orange = ActiveDocument.Range(myrange.Start, myrange.End)
                
                With orange
                .Collapse
                .MoveUntil cset:=" "
                .SetRange Start:=.Start, End:=.Start + 1
                .Select
                End With
                
                Dim c As Font, rslt As Integer
                Set c = Selection.Font
                rslt = c.Spacing + 1
                
                With myrange.Find
                .ClearFormatting
                .Replacement.ClearFormatting
                .Replacement.Font.Spacing = rslt
                .Text = " "
                .Replacement.Text = "^&"
                .Forward = False
                .Wrap = wdFindStop
                .Format = True
                End With
                myrange.Find.Execute Replace:=wdReplaceAll
                End Sub
                
                
                menajemmendelM מנותק
                menajemmendelM מנותק
                menajemmendel
                כתב ב נערך לאחרונה על ידי
                #41

                @pcinfogmach למה בלופ, מה רע לך בחפש והחלף? וכי הוא לא יותר מהיר?

                P 2 תגובות תגובה אחרונה
                0
                • menajemmendelM menajemmendel

                  @pcinfogmach למה בלופ, מה רע לך בחפש והחלף? וכי הוא לא יותר מהיר?

                  P מנותק
                  P מנותק
                  pcinfogmach
                  מדריכים
                  כתב ב נערך לאחרונה על ידי pcinfogmach
                  #42

                  @menajemmendel
                  חפש והחלף אכן יותר מהיר ויעיל
                  היה לי 2 בעיות עם חפש והחלף אחד מהם @מאקרו עזר לי לפתור כך שאין צורך להעלות כאן כרגע
                  השני עדיין עומד, שעל ידי חפש והחלף אם יש רווחים עם גדלים שונים במקטע אז זה ידרוס אותם ויעשה הכל רווחים אחידים אשמח לשמוע אם יש לך פיתרון לזה

                  מ תגובה 1 תגובה אחרונה
                  0
                  • P pcinfogmach

                    @menajemmendel
                    חפש והחלף אכן יותר מהיר ויעיל
                    היה לי 2 בעיות עם חפש והחלף אחד מהם @מאקרו עזר לי לפתור כך שאין צורך להעלות כאן כרגע
                    השני עדיין עומד, שעל ידי חפש והחלף אם יש רווחים עם גדלים שונים במקטע אז זה ידרוס אותם ויעשה הכל רווחים אחידים אשמח לשמוע אם יש לך פיתרון לזה

                    מ מנותק
                    מ מנותק
                    מאקרו
                    כתב ב נערך לאחרונה על ידי
                    #43

                    @pcinfogmach תעשה חפש את הבא במקום החלף הכל, וכשנמצא רווח תגדיל אותו באופן פרטני.

                    תגובה 1 תגובה אחרונה
                    1
                    • menajemmendelM menajemmendel

                      @pcinfogmach למה בלופ, מה רע לך בחפש והחלף? וכי הוא לא יותר מהיר?

                      P מנותק
                      P מנותק
                      pcinfogmach
                      מדריכים
                      כתב ב נערך לאחרונה על ידי
                      #44

                      @menajemmendel כתב בשיתוף | אינצקלופדיה שיתופית עבור קודים של מאקרו - איך עושים את....:

                      @pcinfogmach למה בלופ, מה רע לך בחפש והחלף? וכי הוא לא יותר מהיר?

                      ניסית בחפש והחלף אבל לבינתיים אני לא מצליח שיעשה החלפה רק בפסקאות שסומנו. (השיטה הרגילה שלי לחיפוש במיקום מסויים עובדת רק בלי בחירת עיצוב).

                      menajemmendelM תגובה 1 תגובה אחרונה
                      0
                      • P pcinfogmach

                        @menajemmendel כתב בשיתוף | אינצקלופדיה שיתופית עבור קודים של מאקרו - איך עושים את....:

                        @pcinfogmach למה בלופ, מה רע לך בחפש והחלף? וכי הוא לא יותר מהיר?

                        ניסית בחפש והחלף אבל לבינתיים אני לא מצליח שיעשה החלפה רק בפסקאות שסומנו. (השיטה הרגילה שלי לחיפוש במיקום מסויים עובדת רק בלי בחירת עיצוב).

                        menajemmendelM מנותק
                        menajemmendelM מנותק
                        menajemmendel
                        כתב ב נערך לאחרונה על ידי
                        #45

                        @pcinfogmach כתב בשיתוף | אינצקלופדיה שיתופית עבור קודים של מאקרו - איך עושים את....:

                        @menajemmendel כתב בשיתוף | אינצקלופדיה שיתופית עבור קודים של מאקרו - איך עושים את....:

                        @pcinfogmach למה בלופ, מה רע לך בחפש והחלף? וכי הוא לא יותר מהיר?

                        ניסית בחפש והחלף אבל לבינתיים אני לא מצליח שיעשה החלפה רק בפסקאות שסומנו. (השיטה הרגילה שלי לחיפוש במיקום מסויים עובדת רק בלי בחירת עיצוב).

                        מה אתה מתכוןן? קודם מגדירים שההבחירה יהיה RANGE ואחר כן
                        במקום

                        Selection.Find
                        

                        עושים

                        myrange.Find
                        

                        ואז אתה יכול לחפש מה שאתה רוצה כרגיל,

                        P תגובה 1 תגובה אחרונה
                        1
                        • menajemmendelM menajemmendel

                          @pcinfogmach כתב בשיתוף | אינצקלופדיה שיתופית עבור קודים של מאקרו - איך עושים את....:

                          @menajemmendel כתב בשיתוף | אינצקלופדיה שיתופית עבור קודים של מאקרו - איך עושים את....:

                          @pcinfogmach למה בלופ, מה רע לך בחפש והחלף? וכי הוא לא יותר מהיר?

                          ניסית בחפש והחלף אבל לבינתיים אני לא מצליח שיעשה החלפה רק בפסקאות שסומנו. (השיטה הרגילה שלי לחיפוש במיקום מסויים עובדת רק בלי בחירת עיצוב).

                          מה אתה מתכוןן? קודם מגדירים שההבחירה יהיה RANGE ואחר כן
                          במקום

                          Selection.Find
                          

                          עושים

                          myrange.Find
                          

                          ואז אתה יכול לחפש מה שאתה רוצה כרגיל,

                          P מנותק
                          P מנותק
                          pcinfogmach
                          מדריכים
                          כתב ב נערך לאחרונה על ידי
                          #46
                          פוסט זה נמחק!
                          תגובה 1 תגובה אחרונה
                          0
                          • P מנותק
                            P מנותק
                            pcinfogmach
                            מדריכים
                            כתב ב נערך לאחרונה על ידי pcinfogmach
                            #47

                            איך ליצור range נפרד עבור כל טור בהערות שוליים
                            המאקרו לא עושה כלום כרגע רק קובע range נפרד עבור כל טור כדי לאפשר לעשות עליהם פעולות
                            המאקרו בנוי בשביל לרוץ על העמוד הנוכחי כדי להריץ על כל המסמך יש ליצור לולאה שתרוץ על כל העמודים במסמך.

                            Sub טורים()
                            
                            'נתוני עמוד
                            Dim currpagenum, pg2num As Long
                            Dim currPageRange As Range
                            
                            If ActiveWindow.View.SeekView = wdSeekFootnotes Then ActiveWindow.View.SeekView = wdSeekMainDocument
                            
                            currpagenum = Selection.Information(wdActiveEndPageNumber)
                            Set currPageRange = ActiveDocument.Bookmarks("\page").Range
                            
                            'נתוני הערות שוליים
                            Dim ftnoteclmn1 As Range
                            Dim ftnoteclmn2 As Range
                            Dim i As Integer, lastftnote As Integer
                            Dim ftnote As footnote
                            
                            'הגדר את תחילת הטור הראשון בהערות שוליים
                            ActiveWindow.View.SeekView = wdSeekFootnotes
                            Set ftnoteclmn1 = Selection.Range
                            
                            'מצא את המעבר בין הטורים על ידי לולאה
                            lastftnote = currPageRange.Footnotes.Count
                            For i = 1 To lastftnote
                                    Set ftnote = currPageRange.Footnotes(i)
                                    If ftnote.Range.Information(wdHorizontalPositionRelativeToPage) < ActiveDocument.PageSetup.pageWidth / 2 Then
                                        ftnote.Range.Select
                                        Selection.HomeKey Unit:=wdLine
                                            
                                        Do While Selection.Information(wdHorizontalPositionRelativeToPage) < ActiveDocument.PageSetup.pageWidth / 2
                                            Selection.MoveLeft Unit:=wdWord, Count:=1
                                        Loop
                                        Selection.MoveRight Unit:=wdWord, Count:=1
                                        Exit For
                                    End If
                                Next
                                
                            'הגדר את סוף הטור הראשון 
                            ftnoteclmn1.End = Selection.Range.Start
                            
                            'הגדר את תחילת הטור השני
                            Set ftnoteclmn2 = Selection.Range
                            
                            'מצא את סוף העמוד
                            currPageRange.Footnotes(lastftnote).Range.Select
                            Selection.EndKey Unit:=wdLine
                            
                            pg2num = Selection.Information(wdActiveEndPageNumber)
                            Do While pg2num <> currpagenum
                                Selection.MoveLeft Unit:=wdWord, Count:=1
                                pg2num = Selection.Range.Information(wdActiveEndPageNumber)
                            Loop
                            'Selection.MoveRight Unit:=wdWord, Count:=1
                            
                            'הגדר את סוף הטור השני
                            ftnoteclmn2.End = Selection.Range.Start
                            
                            End Sub
                            
                            תגובה 1 תגובה אחרונה
                            0
                            • P מנותק
                              P מנותק
                              pcinfogmach
                              מדריכים
                              כתב ב נערך לאחרונה על ידי pcinfogmach
                              #48

                              מאקרו חמוד להעתקת כל המודולים הרגילים וכל חלקי היוזרפורם מתוך תבנית אחת לשניה

                              Sub CopyModulesToTemplate()
                                  Dim sourceTemplate As Document
                                  Dim destinationTemplate As Document
                                  Dim sourceVBProject As Object
                                  Dim destinationVBProject As Object
                                  Dim sourceComponent As Object
                                  Dim destinationComponent As Object
                              
                                  ' Set the source and destination templates
                                  Set sourceTemplate = Documents.Open("C:\tosaf\t.dotm")
                                  Set destinationTemplate = Documents.Open("C:\tosaf\n.dotm")
                                  
                                  ' Get the VB projects from the templates
                                  Set sourceVBProject = sourceTemplate.VBProject
                                  Set destinationVBProject = destinationTemplate.VBProject
                              
                                  ' Copy each module and user form from the source template to the destination template
                                  For Each sourceComponent In sourceVBProject.VBComponents
                                      ' Skip any components that are not modules or user forms
                                      If sourceComponent.Type = 1 Or sourceComponent.Type = 3 Then ' 1 = vbext_ct_StdModule, 3 = vbext_ct_MSForm
                                          ' Copy the component
                                          sourceComponent.Export sourceComponent.Name & ".bas"
                                          Set destinationComponent = destinationVBProject.VBComponents.Import(sourceComponent.Name & ".bas")
                                          ' Clean up the exported file
                                          Kill sourceComponent.Name & ".bas"
                                          ' Optionally rename the component in the destination template
                                          On Error Resume Next
                                          destinationComponent.Name = sourceComponent.Name
                                      End If
                                  Next sourceComponent
                              
                                  ' Save and close the templates
                                  sourceTemplate.Close SaveChanges:=False
                                  destinationTemplate.Save
                                  destinationTemplate.Close SaveChanges:=True
                              End Sub
                              
                              

                              ובגירסה זו הוא עושה גם עדכון למודולים שקיימים בתבנית השנייה

                              Sub CopyModulesToTemplate()
                                  Dim sourceTemplate As Document
                                  Dim destinationTemplate As Document
                                  Dim sourceVBProject As Object
                                  Dim destinationVBProject As Object
                                  Dim sourceComponent As Object
                                  Dim destinationComponent As Object
                                  Dim existingComponent As Object
                              
                                  ' Set the source and destination templates
                                  Set sourceTemplate = Documents.Open("C:\tosaf\t.dotm")
                                  Set destinationTemplate = Documents.Open("C:\tosaf\n.dotm")
                                  
                                  ' Get the VB projects from the templates
                                  Set sourceVBProject = sourceTemplate.VBProject
                                  Set destinationVBProject = destinationTemplate.VBProject
                              
                              ' Copy each module and user form from the source template to the destination template
                                  For Each sourceComponent In sourceVBProject.VBComponents
                                      ' Skip any components that are not modules or user forms
                                      If sourceComponent.Type = 1 Or sourceComponent.Type = 3 Then ' 1 = vbext_ct_StdModule, 3 = vbext_ct_MSForm
                                          ' Check if a component with the same name already exists in the destination template
                                          Set existingComponent = destinationVBProject.VBComponents.Item(sourceComponent.Name)
                                          If Not existingComponent Is Nothing Then
                                              ' If a component with the same name exists, remove it before importing the new component
                                              destinationVBProject.VBComponents.remove existingComponent
                                          End If
                                          ' Copy the component
                                          sourceComponent.Export sourceComponent.Name & ".bas"
                                          Set destinationComponent = destinationVBProject.VBComponents.Import(sourceComponent.Name & ".bas")
                                          ' Clean up the exported file
                                          Kill sourceComponent.Name & ".bas"
                                          ' Optionally rename the component in the destination template
                                          destinationComponent.Name = sourceComponent.Name
                                      End If
                                  Next sourceComponent
                              
                                  ' Save and close the templates
                                  sourceTemplate.Close SaveChanges:=False
                                  destinationTemplate.Save
                                  destinationTemplate.Close SaveChanges:=True
                              End Sub
                              
                              תגובה 1 תגובה אחרונה
                              2
                              • P מנותק
                                P מנותק
                                pcinfogmach
                                מדריכים
                                כתב ב נערך לאחרונה על ידי
                                #49

                                קוד לשינוי שפת המקלדת לעברית

                                Option Private Module
                                
                                Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
                                Private Declare Function ActivateKeyboardLayout Lib "user32" (ByVal hkl As Long, ByVal flags As Long) As Long
                                
                                Private Const LANG_HEBREW As Long = &H40D
                                
                                Public Sub SetHebrewInputLanguage()
                                    Dim keyboardLayout As String * 8 ' Maximum size for the keyboard layout name
                                    Dim result As Long
                                    
                                    ' Call the GetKeyboardLayoutName function
                                    result = GetKeyboardLayoutName(keyboardLayout)
                                    
                                    ' Check if the function call was successful (non-zero result)
                                    If result <> 0 Then
                                    
                                        ' The keyboardLayout string now contains the language identifier
                                        Dim languageID As String
                                        languageID = Left(keyboardLayout, 8)
                                        
                                        ' Check if the language identifier is for Hebrew (0000040D)
                                        If StrComp(languageID, "0000040D", vbTextCompare) = 0 Then
                                            Debug.Print "Current input language is already Hebrew."
                                        Else
                                            
                                            ' Change the input language to Hebrew
                                            Dim hkl As Long
                                            hkl = LANG_HEBREW
                                            result = ActivateKeyboardLayout(hkl, 0)
                                            
                                            If result <> 0 Then
                                                Debug.Print "Input language changed to Hebrew."
                                            Else
                                                Debug.Print "Failed to change the input language to Hebrew."
                                            End If
                                        End If
                                    Else
                                        Debug.Print "Failed to retrieve the input language."
                                    End If
                                End Sub
                                
                                
                                
                                
                                תגובה 1 תגובה אחרונה
                                1
                                • P מנותק
                                  P מנותק
                                  pcinfogmach
                                  מדריכים
                                  כתב ב נערך לאחרונה על ידי pcinfogmach
                                  #50

                                  קוד לייצוא שמות הקבצים מתוך תיקייה מסויימת (הקוד מייצא גם את נתיב הקובץ וגם את שם הקובץ)
                                  שימו לב! כרגע היצוא הוא בשיטת debug יש להחליף לשיטת הייצוא הרצויה.

                                  Sub FindFilesInDirectoryAndSubfoldersLateBound()
                                      Dim fso As Object ' Declare fso as Object data type
                                      Dim folderPath As String
                                      Dim myFolder As Object ' Declare myFolder as Object data type
                                      Dim subfolder As Object ' Declare subfolder as Object data type
                                      Dim file As Object ' Declare file as Object data type
                                  
                                      ' Set the folder path where you want to search for files
                                      folderPath = "C:\Users\0533105132\Documents\ToratEmetInstall\Books" ' Replace with the desired folder path
                                  
                                      ' Create a new late-bound FileSystemObject
                                      Set fso = CreateObject("Scripting.FileSystemObject")
                                  
                                      ' Check if the specified folder exists
                                      If fso.FolderExists(folderPath) Then
                                          ' Get the Folder object for the specified folder
                                          Set myFolder = fso.getfolder(folderPath)
                                  
                                          ' Call the recursive function to search files in the main folder and its subfolders
                                          ProcessFolder myFolder
                                      Else
                                          ' Folder does not exist
                                          MsgBox "Folder not found: " & folderPath
                                      End If
                                  
                                      ' Release the objects
                                      Set file = Nothing
                                      Set subfolder = Nothing
                                      Set myFolder = Nothing
                                      Set fso = Nothing
                                  End Sub
                                  
                                  Sub ProcessFolder(ByVal folder As Object)
                                      Dim myfile As Object
                                      Dim subfolder As Object
                                  
                                      ' Process files in the current folder
                                      For Each myfile In folder.Files
                                          ' Print the file name (you can perform any desired action here)
                                          Debug.Print myfile.Path
                                          Debug.Print myfile.Name
                                          
                                      Next myfile
                                  
                                      ' Recursively process subfolders
                                      For Each subfolder In folder.Subfolders
                                          ProcessFolder subfolder
                                      Next subfolder
                                  End Sub
                                  
                                  תגובה 1 תגובה אחרונה
                                  1
                                  • ד דאנציג התייחס לנושא זה

                                  • התחברות

                                  • אין לך חשבון עדיין? הרשמה

                                  • התחברו או הירשמו כדי לחפש.
                                  • פוסט ראשון
                                    פוסט אחרון
                                  0
                                  • חוקי הפורום
                                  • פופולרי
                                  • לא נפתר
                                  • משתמשים
                                  • חיפוש גוגל בפורום
                                  • צור קשר