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

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 למה שאתה צריך, בקשר למיקום, עשיתי שייקח מיקום נוכחי.

searchnicks

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

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

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

dovid

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

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

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

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

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

searchnicks

@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 זה מס' הגליון, תוכל להחליף זאת במספר אחר או בשם (אבל מוקף מרכאות).

searchnicks

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

searchnicks

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

searchnicks

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

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

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

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

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

dovid

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

searchnicks

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

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

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

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

dovid

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

searchnicks

@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

dovid

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

searchnicks

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

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

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

searchnicks

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

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

רק לאחר לחיצה

dovid

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

searchnicks

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

searchnicks

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

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

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

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

searchnicks

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

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

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

תחומים - פורום חרדי מקצועי

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

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