Avatar billede tvc Seniormester
03. marts 2017 - 19:25 Der er 8 kommentarer

Ændring i Datavalidering ved VBA

Hej

Jeg vil gerne lave en opdatering (Makro), der skal afvikles i den aktive workbook, men ikke være en del af denne.

Kan jeg gøre dette ved at lægge den ind som en menu, eller hvordan kan jeg får en makro i en anden fil afvikle og henvise til ark i denne anden fil?
Avatar billede vegaz Juniormester
03. marts 2017 - 22:24 #1
Er der en grund til du vil gøre det sådan? Men ja, du kan godt åbne en anden workbook (end den du har åben) og køre en makro fra den via din åbne workbook.

Har du selv noget kode?
Avatar billede vegaz Juniormester
03. marts 2017 - 22:26 #2
Application.Run "'MacroBook'!MacroName"
Avatar billede tvc Seniormester
04. marts 2017 - 15:36 #3
Jeg vil gerne kunne opdatere en model, som jeg har distribueret til resten af firmaet. Jeg vil gerne have at den enkelte medarbejder kan opdatere den model de sidder med ved blot at afvikle en makro fra en anden projektmappe.

Eksempelvis vil jeg gerne rette nogle funktioner i navngivne ark:

    Ark00.Range("C22").FormulaR1C1 = "=IF(INDIRECT(""'OP_""&VLOOKUP(RC[-2],L_Mappenavn_Kontoognavniet,2,FALSE)&""'!$A$25"")=(R18C1&"":""),INDIRECT(""'OP_""&VLOOKUP(RC[-2],L_Mappenavn_Kontoognavniet,2,FALSE)&""'!$A$26""),""Ingen"")"
    Ark00.Range("C24").FormulaR1C1 = "=IF(INDIRECT(""'OP_""&VLOOKUP(RC[-2],L_Mappenavn_Kontoognavniet,2,FALSE)&""'!$A$25"")=(R18C1&"":""),INDIRECT(""'OP_""&VLOOKUP(RC[-2],L_Mappenavn_Kontoognavniet,2,FALSE)&""'!$A$26""),""Ingen"")"
    Ark00.Range("C46").FormulaR1C1 = "=IF(INDIRECT(""'OP_""&VLOOKUP(RC[-2],L_Mappenavn_Kontoognavniet,2,FALSE)&""'!$A$25"")=(R42C1&"":""),INDIRECT(""'OP_""&VLOOKUP(RC[-2],L_Mappenavn_Kontoognavniet,2,FALSE)&""'!$A$26""),""Ingen"")"
    Ark00.Range("C48").FormulaR1C1 = "=IF(INDIRECT(""'OP_""&VLOOKUP(RC[-2],L_Mappenavn_Kontoognavniet,2,FALSE)&""'!$A$25"")=(R42C1&"":""),INDIRECT(""'OP_""&VLOOKUP(RC[-2],L_Mappenavn_Kontoognavniet,2,FALSE)&""'!$A$26""),""Ingen"")"
    Ark00.Range("C70").FormulaR1C1 = "=IF(INDIRECT(""'OP_""&VLOOKUP(RC[-2],L_Mappenavn_Kontoognavniet,2,FALSE)&""'!$A$25"")=(R66C1&"":""),INDIRECT(""'OP_""&VLOOKUP(RC[-2],L_Mappenavn_Kontoognavniet,2,FALSE)&""'!$A$26""),""Ingen"")"
    Ark00.Range("C72").FormulaR1C1 = "=IF(INDIRECT(""'OP_""&VLOOKUP(RC[-2],L_Mappenavn_Kontoognavniet,2,FALSE)&""'!$A$25"")=(R66C1&"":""),INDIRECT(""'OP_""&VLOOKUP(RC[-2],L_Mappenavn_Kontoognavniet,2,FALSE)&""'!$A$26""),""Ingen"")"
Avatar billede vegaz Juniormester
04. marts 2017 - 17:38 #4
Jeg er ikke sikker på jeg forstår :-) I har 1 workbook som er delt på et shared drive? I den workbook, skal man kunne køre en makro som den læser fra en anden workbook?
Avatar billede tvc Seniormester
04. marts 2017 - 19:07 #5
Alle medarbejdere har flere StandardWorkbook (den fil jeg gerne vil kunne foretage opdateringer til) liggende i vores ESDH under de forskellige kunder.

Jeg vil med UpdateWorkbook gerne kunne foretage ændringer/opdateringer i StandardWorkbook.
Avatar billede vegaz Juniormester
04. marts 2017 - 19:20 #6
Altså du kan sagtens opdatere andre workbooks fra en makro, men hvorfor åbner du ikke bare StandardWorkbook og laver opdateringen? Hvad vinder du/I på at du skal kode alle dine opdateringer/ændringer?
Måske er det fordi jeg ikke kan se det smarte i det :-) Er det blot formler du vil ændre?
En løsning kunne være at lave en makro i din UpdateWorkbook, som åbner en dialog box hvor du kan vælge den Excel workbook som du vil opdatere (StandardWorkbook). I din UpdateWorkbook har du den nye formel i en specifik celle, f.eks. A2. Efter du har åbnet StandardWorkbook, så kan en input box komme frem, hvor du angiver rangen (f.eks. B2:D2) hvor den nye formel skal ind.
Er det sådan noget du er ude efter?
Avatar billede tvc Seniormester
04. marts 2017 - 21:18 #7
Det er noget i den stil. Der er rigtig mange rettelser til formler, datavalidering, formatering og ligeledes ændringer i nogle makroer og userforms.

Hvordan vil du lave en MSGboks der kan søge efter åbne Workbooks og vise en liste over disse, give mulighed for at vælge en Workbook, der efter valg kan anvendes foran mine ændringslinjer?
Avatar billede vegaz Juniormester
05. marts 2017 - 13:25 #8
Hej igen

Jeg har lavet dette til dig, jeg håber det gør som du ønsker eller kan hjælpe dig på vej.
Indsæt nedenstående kode i et nyt module i VBA og kør "Open_Workbook_Insert_Formula" proceduren.
Det der sker, er at den beder dig om at åbne den Excel workbook som du vil have opdateret formlerne i. Derefter skal du vælge den range hvor du vil indsætte formlen - formlen bliver indsat fra den workbook, hvor du kører makroen fra, i det aktive ark i cell A2.
Den vil automatisk lave en "autofill", så celle referencer bliver opdateret ligesom hvis du bruger autofill i Excel.
Du kan også selv "afkommentere" Debug.Print og se hvad der sker i dit  Immediate window når du laver en step through/into (F8).

Option Explicit
Public strFname As String, strShtUpdate As String
Public wkbUpdate As Workbook

Sub Open_Workbook_Insert_Formula()
    Dim SaveDriveDir As String
    Dim strMyPath As String
    Dim varFnameWPath As Variant
    Dim N As Long
    Dim wkb As Workbook
   
    Set wkbUpdate = ThisWorkbook
    strShtUpdate = wkbUpdate.ActiveSheet.Name
   
    ' Save the current directory.
    SaveDriveDir = CurDir

    ' Set the path to the folder that you want to open
    strMyPath = Application.DefaultFilePath

    ' Change drive/directory to strMyPath
    ChDrive strMyPath
    ChDir strMyPath

    ' Open GetOpenFilename with the file filters.
    varFnameWPath = Application.GetOpenFilename( _
            FileFilter:="Excel Workbooks (*.xls*),*.xls*", _
            Title:="Select an Excel workbook", _
            MultiSelect:=False)

        If varFnameWPath = False Then Exit Sub ' If Cancel then exit procedure
       
        With Application ' Speed up sheet
            .ScreenUpdating = False
            .EnableEvents = False
        End With

            ' Get only the file name and test to see if it is open.
            strFname = Right(varFnameWPath, Len(varFnameWPath) - InStrRev(varFnameWPath, Application.PathSeparator, , 1))
            If bIsBookOpen(strFname) = False Then

                Set wkb = Nothing
                On Error Resume Next
                Set wkb = Workbooks.Open(varFnameWPath)
                On Error GoTo 0

                If Not wkb Is Nothing Then
                    ' Do nothing when opened, just continue
                End If
            Else ' If already open then
                MsgBox "You cannot open this file : " & varFnameWPath & " because it is already open." & vbNewLine & _
                        "Please close the workbook and try again"
                GoTo EndOfFile
            End If
           
            ' After workbook is open, start
            Call SelectUserRange(strFname, wkbUpdate, strShtUpdate)
           
EndOfFile:
        With Application ' Reset settings
            .ScreenUpdating = True
            .EnableEvents = True
        End With

    ' Change drive/directory back to SaveDriveDir.
    ChDrive SaveDriveDir
    ChDir SaveDriveDir
End Sub

Function bIsBookOpen(ByRef szBookName As String) As Boolean
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Sub SelectUserRange(strFname, wkbUpdate, shtUpdate)
    Dim UserRange As Range
    Dim strRangeSheet As String, strRangeWkb As String
   
ReTry:
    On Error GoTo ReTry
    'Debug.Print strFname
    Workbooks(strFname).Activate
    Worksheets(1).Activate
   
    Application.ScreenUpdating = True ' Must be enabled for the InputBox to work
   
    Set UserRange = Application.InputBox(prompt:="Please Select Range", Title:="Range Select", Type:=8)
   
    Application.ScreenUpdating = False
   
    'Debug.Print UserRange.Address
    'Debug.Print UserRange.Worksheet.Name
    strRangeSheet = UserRange.Worksheet.Name
    'Debug.Print UserRange.Worksheet.Parent.Name
    strRangeWkb = UserRange.Worksheet.Parent.Name
    'Debug.Print wkbUpdate.Name
   
    Workbooks(strRangeWkb).Worksheets(strRangeSheet).Range(UserRange.Address).Formula = Workbooks(wkbUpdate.Name).Worksheets(strShtUpdate).Range("A2").Formula
End Sub
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester