תחומים
    • הרשמה
    • התחברות
    • חיפוש
    • קטגוריות
    • פוסטים אחרונים
    • משתמשים
    • חיפוש
    חוקי הפורום

    עריכת קוד VBA באקסל

    תכנות
    2
    23
    1173
    טוען פוסטים נוספים
    • מהישן לחדש
    • מהחדש לישן
    • הכי הרבה הצבעות
    תגובה
    • הגב כנושא
    התחבר בכדי לפרסם תגובה
    נושא זה נמחק. רק משתמשים עם הרשאות מתאימות יוכלו לצפות בו.
    • searchnicks
      searchnicks נערך לאחרונה על ידי searchnicks

      שלום
      מצאתי כאן קוד מאקרו שתכליתו לייבא רשימת קבצים הקיימים בתיקיה

      אני רוצה להוסיף לקוד שני דברים

      1. נתיב תיקיה קבועה, (כרגע הקוד פותח חלון שבו יש לנווט לבחירת תיקיה)

      2. בחירת מיקום שבו הנתונים ימוקמו

      אעריך אם מישהו יכול לעזור לי בזה

      תגובה 1 תגובה אחרונה תגובה ציטוט 0
      • dovid
        dovid ניהול נערך לאחרונה על ידי

        Sub GetFileList()
            Dim xFSO As Object
            Dim xFolder As Object
            Dim xFile As Object
            Dim xPath As String
            Dim i As Integer
            Dim locationX, locationY As Integer
            
            xPath = "C:\Program Files"
            
            Set xFSO = CreateObject("Scripting.FileSystemObject")
            Set xFolder = xFSO.GetFolder(xPath)
             
            
            locationX = ActiveCell.Row
            locationY = ActiveCell.Column
            
            ActiveSheet.Cells(locationX, locationY) = "Folder name"
            ActiveSheet.Cells(locationX, locationY + 1) = "File name"
            ActiveSheet.Cells(locationX, locationY + 2) = "File extension"
            i = locationX
            For Each xFile In xFolder.Files
                i = i + 1
                ActiveSheet.Cells(i, locationY) = xPath
                ActiveSheet.Cells(i, locationY + 1) = Left(xFile.Name, InStrRev(xFile.Name, ".") - 1)
                ActiveSheet.Cells(i, locationY + 2) = Mid(xFile.Name, InStrRev(xFile.Name, ".") + 1)
            Next
        End Sub
        

        תשנה את הc:\Program Files למה שאתה צריך, בקשר למיקום, עשיתי שייקח מיקום נוכחי.

        אפשר ליצור קשר dovid@tchumim.com

        searchnicks תגובה 1 תגובה אחרונה תגובה ציטוט 4
        • searchnicks
          searchnicks @dovid נערך לאחרונה על ידי searchnicks

          @dovid
          תודה רבה!
          עזרת לי מאד
          אם אפשר ואתה פנוי ויכול אני מבקש נתיב להצבת הנתונים כנ"ל

          בחירת מיקום בו הנתונים ימוקמו

          כך שאוכל לכתוב שיציב בגיליון2!A5
          זה חשוב לי כי אני מפעיל את המאקרו בגיליון 1 ואמור להציב בגיליון 2

          dovid תגובה 1 תגובה אחרונה תגובה ציטוט 0
          • dovid
            dovid ניהול @searchnicks נערך לאחרונה על ידי

            @מתמחה-במחשבים אמר בעריכת קוד VBA באקסל:

            @dovid
            תודה רבה!
            עזרת לי מאד
            אם אפשר ואתה פנוי ויכול אני מבקש נתיב להצבת הנתונים כנ"ל

            בחירת מיקום בו הנתונים ימוקמו

            כך שאוכל לכתוב שיציב בגיליון2!A5
            זה חשוב לי כי אני מפעיל את המאקרו בגיליון 1 ואמור להציב בגיליון 2

            אתה רוצה לכתוב את הפרמטר הזה שרירותית בקוד או לקבל את זה באיזה מקום כפרמטר?

            אפשר ליצור קשר dovid@tchumim.com

            searchnicks תגובה 1 תגובה אחרונה תגובה ציטוט 2
            • searchnicks
              searchnicks @dovid נערך לאחרונה על ידי

              @dovid
              תודה רבה על הרצון שלך לעזור
              לא כל כך הבנתי מה התכוונת
              אני רוצה לכתוב בקוד שיציב את הנתונים שקיבל במקום מסויים שאציין בתוך הקוד

              תגובה 1 תגובה אחרונה תגובה ציטוט 0
              • dovid
                dovid ניהול נערך לאחרונה על ידי

                Sub GetFileList()
                    Dim xFSO As Object
                    Dim xFolder As Object
                    Dim xFile As Object
                    Dim xPath As String
                    Dim i As Integer
                    Dim location As Range
                    
                    xPath = "C:\Program Files"
                    
                    Set xFSO = CreateObject("Scripting.FileSystemObject")
                    Set xFolder = xFSO.GetFolder(xPath)
                     
                    
                    Set location = Worksheets(1).Range("A5")
                
                    
                    location.Value = "Folder name"
                    location.Offset(0, 1) = "File name"
                    location.Offset(0, 2) = "File extension"
                    i = 0
                    For Each xFile In xFolder.Files
                        i = i + 1
                        location.Offset(i, 0) = xPath
                        location.Offset(i, 1) = Left(xFile.Name, InStrRev(xFile.Name, ".") - 1)
                        location.Offset(i, 2) = Mid(xFile.Name, InStrRev(xFile.Name, ".") + 1)
                    Next
                End Sub
                

                הכתובת נמצאת במקטע Worksheets(1).Range("A5")
                ה1 זה מס' הגליון, תוכל להחליף זאת במספר אחר או בשם (אבל מוקף מרכאות).

                אפשר ליצור קשר dovid@tchumim.com

                searchnicks תגובה 1 תגובה אחרונה תגובה ציטוט 2
                • searchnicks
                  searchnicks @dovid נערך לאחרונה על ידי

                  @dovid
                  תודה רבה!
                  עובד היטב!
                  חסכת לי הרבה עבודה!

                  תגובה 1 תגובה אחרונה תגובה ציטוט 1
                  • searchnicks
                    searchnicks נערך לאחרונה על ידי

                    @dovid
                    אני רואה כי הדלת פתוחה
                    אז אני מרשה לעצמי לשאול
                    תוכל לתת לי הקוד הנל
                    אבל שהנתיב תיקיה יופנה לתא בגיליון (שבו יהיה רשום הנתיב תיקיה)
                    כמובן רק אם זה לא מטריח אותך...

                    searchnicks תגובה 1 תגובה אחרונה תגובה ציטוט 0
                    • searchnicks
                      searchnicks @searchnicks נערך לאחרונה על ידי searchnicks

                      @מתמחה-במחשבים אמר בעריכת קוד VBA באקסל:

                      @dovid
                      אני רואה כי הדלת פתוחה
                      אז אני מרשה לעצמי לשאול
                      תוכל לתת לי הקוד הנל
                      אבל שהנתיב תיקיה יופנה לתא בגיליון (שבו יהיה רשום הנתיב תיקיה)
                      כמובן רק אם זה לא מטריח אותך...

                      ניסיתי לעשות בעצמי
                      כך שבמקום xPats (המשתנה בסוגריים)
                      הכנסתי

                      range("גיליון1!H5").value
                      

                      הרעיון לעצמו עובד
                      אך שאני מפעיל אותו הוא לוקח זמן רב
                      איפה טעיתי?

                      dovid תגובה 1 תגובה אחרונה תגובה ציטוט 1
                      • dovid
                        dovid ניהול @searchnicks נערך לאחרונה על ידי

                        @מתמחה-במחשבים
                        עשית מצויין ואני לא רואה סיבה שזה לוקח זמן.
                        ניסיתי אצלי ועבד מצויין. בדוק נתיב תיקיה אחר (אולי הבעיה זה גישה לאחד הקבצים שם).

                        אפשר ליצור קשר dovid@tchumim.com

                        searchnicks תגובה 1 תגובה אחרונה תגובה ציטוט 1
                        • searchnicks
                          searchnicks @dovid נערך לאחרונה על ידי searchnicks

                          @dovid
                          קודם תודה רבה על הציון לשבח

                          עליתי על מתי שקורה לי הבעיה
                          אקדים בקצרה
                          בניתי שני כפתורים באקסל
                          כפתור אחד מאקרו שמציב נתיב תיקיה שבחרתי (בדו שיח)
                          וכפתור שני שמציב רשימת קבצים (חוברות עבודה) שנמצאים בתוך התיקיה

                          כעת שאני מפעיל הכפתור השני לרענון הרשימת הקבצים עובד ללא דופי
                          אך שאני מפעיל הכפתור הראשון שאמור להציב את הנתיב של התיקיה, לוקח לו זמן רב (מחשב 4 הליכי משנה וכו')
                          ככל הנראה, מכיוון שהמאקרו השני שואב את הרשימת קבצים לפי נתיב בתא שהמאקרו הראשון מציב, כנראה שיוצרת בעיה מסויימת

                          אם תרצה אתאר לשם מה אני משתמש בזה

                          תגובה 1 תגובה אחרונה תגובה ציטוט 0
                          • dovid
                            dovid ניהול נערך לאחרונה על ידי

                            אין לי מושג מה הבעיה, אבל התיאוריה שגויה.
                            הבעיה היא ככל הנראה בקוד הכפתור הראשון אותו אינני מכיר ומעולם לא ראיתי.

                            אפשר ליצור קשר dovid@tchumim.com

                            searchnicks תגובה 1 תגובה אחרונה תגובה ציטוט 0
                            • searchnicks
                              searchnicks @dovid נערך לאחרונה על ידי

                              @dovid
                              זה הקוד כפתור ראשון

                              Sub browseFolderPath()
                                  On Error GoTo err
                                  Dim fileExplorer As FileDialog
                                  Set fileExplorer = Application.FileDialog(msoFileDialogFolderPicker)
                                  
                                  'To allow or disable to multi select
                                  fileExplorer.AllowMultiSelect = False
                                  
                                  With fileExplorer
                                      If .Show = -1 Then 'Any folder is selected
                                          ['גיליון5'!H1] = .SelectedItems.Item(1)
                                      Else ' else dialog is cancelled
                                          MsgBox "עליך לבחור נתיב תיקיה מתאימה"
                                      End If
                                  End With
                              err:
                                  Exit Sub
                              End Sub
                              
                              תגובה 1 תגובה אחרונה תגובה ציטוט 1
                              • dovid
                                dovid ניהול נערך לאחרונה על ידי

                                משונה, הקוד הזה רץ אצלי בלי רגע של שיהוי.
                                יש לתא הזה השפעה על תא אחר כל שהוא?
                                נקוד של הכפתור השני מופעל אוטומטית בשינוי של הראשון או רק לאחר לחיצה?

                                אפשר ליצור קשר dovid@tchumim.com

                                searchnicks 3 תגובות תגובה אחרונה תגובה ציטוט 0
                                • searchnicks
                                  searchnicks @dovid נערך לאחרונה על ידי searchnicks

                                  @dovid אמר בעריכת קוד VBA באקסל:

                                  משונה, הקוד הזה רץ אצלי בלי רגע של שיהוי.
                                  יש לתא הזה השפעה על תא אחר כל שהוא?
                                  נקוד של הכפתור השני מופעל אוטומטית בשינוי של הראשון או רק לאחר לחיצה?

                                  כשאני מחזיר את המאקרו של הכפתור השני לנוסח המקורי (נתיב תיקייה קבועה)
                                  אז אין שום בעייה
                                  ושניהם פועלים יפה ללא דופי
                                  רק מתי שאני משנה לתא שהוצב ע"י הכפתור השני אזי הכפתור השני נתקע

                                  תגובה 1 תגובה אחרונה תגובה ציטוט 0
                                  • searchnicks
                                    searchnicks @dovid נערך לאחרונה על ידי

                                    @dovid אמר בעריכת קוד VBA באקסל:

                                    נקוד של הכפתור השני מופעל אוטומטית בשינוי של הראשון או רק לאחר לחיצה?

                                    רק לאחר לחיצה

                                    תגובה 1 תגובה אחרונה תגובה ציטוט 0
                                    • dovid
                                      dovid ניהול נערך לאחרונה על ידי

                                      לפי הנתונים שלך התיאוריה שלך נכונה, אבל היא לא.
                                      אז מה הפשט? לא יודע.

                                      אפשר ליצור קשר dovid@tchumim.com

                                      searchnicks תגובה 1 תגובה אחרונה תגובה ציטוט 1
                                      • searchnicks
                                        searchnicks @dovid נערך לאחרונה על ידי

                                        @dovid
                                        תודה רבה
                                        איך אוכל לעלות על שורש הבעיה?

                                        תגובה 1 תגובה אחרונה תגובה ציטוט 0
                                        • searchnicks
                                          searchnicks @dovid נערך לאחרונה על ידי

                                          @dovid אמר בעריכת קוד VBA באקסל:

                                          משונה, הקוד הזה רץ אצלי בלי רגע של שיהוי.

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

                                          אין לי מושג איפה קבור הכלב

                                          searchnicks תגובה 1 תגובה אחרונה תגובה ציטוט 0
                                          • searchnicks
                                            searchnicks @searchnicks נערך לאחרונה על ידי

                                            @dovid
                                            בסייעתא דשמיא מצאתי את הכלב
                                            מתברר שהיה לי קוד (פונקציה מותאמת אישית) נוסף (שעבד מאד טוב)
                                            ששאב את הנתון מתא של נתיב קובץ (שהוצב ע"י המאקרו הנל)
                                            התברר שכל פעם שאני משנה את הנתיב של הקובץ הוא מבצע החישובים שוב (דבר שלוקח זמן שמדובר בכמות תאים)
                                            ולא שמתי לב לזה מכיוון שלפני ששמתי את המאקרו לא שיניתי כלל את הנתיב (כי לא היה צורך)

                                            בכל אופן תודה רבה על הרצון לסייע!!!

                                            תגובה 1 תגובה אחרונה תגובה ציטוט 1
                                            • searchnicks
                                              searchnicks נערך לאחרונה על ידי

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

                                              Sub browseFolderPath()
                                                  On Error GoTo err
                                                  Dim fileExplorer As FileDialog
                                                  Dim answer As Integer
                                                  answer = MsgBox("לאחר בחירה מחדש של התיקיית דוחות, יש להמתין מס' דקות כדי לחשב מחדש, האם אתה רוצה להמשיך?", vbYesNo + vbExclamation + vbDefaultButton2 + vbMsgBoxRtlReading)
                                              If answer = vbYes Then
                                                  Set fileExplorer = Application.FileDialog(msoFileDialogFolderPicker)
                                                  
                                                  'To allow or disable to multi select
                                                  fileExplorer.AllowMultiSelect = False
                                                  
                                                  With fileExplorer
                                                      If .Show = -1 Then 'Any folder is selected
                                                          ['גיליון5'!H1] = .SelectedItems.Item(1)
                                                      Else ' else dialog is cancelled
                                                          MsgBox "עליך לבחור נתיב תיקיה מתאימה"
                                                      End If
                                                  End With
                                              err:
                                                  Exit Sub
                                              MsgBox "הנתיב שצוין הוא" & vbNewLine & vbNewLine & Range("'גיליון5'!H1").Value
                                              Else
                                                  'do nothing
                                              End If
                                              End Sub
                                              תגובה 1 תגובה אחרונה תגובה ציטוט 1
                                              • searchnicks
                                                searchnicks נערך לאחרונה על ידי searchnicks

                                                פוסט זה נמחק!
                                                dovid תגובה 1 תגובה אחרונה תגובה ציטוט 0
                                                • dovid
                                                  dovid ניהול @searchnicks נערך לאחרונה על ידי

                                                  @מתמחה-במחשבים נושא חדש בבקשה, בקטגוריה תכנות.

                                                  אפשר ליצור קשר dovid@tchumim.com

                                                  תגובה 1 תגובה אחרונה תגובה ציטוט 0
                                                  • הועבר מ תכנות ע"י  dovid dovid 
                                                  • 1 / 1
                                                  • פוסט ראשון
                                                    פוסט אחרון
                                                  בא תתחבר לדף היומי!