Excel VBA pentru a actualiza un șablon de diagramă de rețea Visio (Programare, Excel, Vba, Visio)

maleante a intrebat.

Sunt în procesul de creare a diagramelor pentru mai multe site-uri din întreprinderea noastră, ca parte a unui efort de implementare a unei noi tehnologii. Am adunat informațiile Într-un document Excel și din acest document am reușit să actualizez diverse documente Word și documente Excel folosind VBA, o imagine a unei porțiuni din foaia mea de calcul împreună cu o mostră a șablonului Visio și starea finală dorită pot fi găsite mai jos.

După ce am căutat pe mai multe site-uri web, am reușit să găsesc următorul cod care va deschide șablonul Visio, dar nu reușesc să îl fac să actualizeze valorile conform așteptărilor. Din câte îmi dau seama, se pare că trec prin diferitele forme, așa cum am menționat, valorile nu se actualizează conform așteptărilor.

Vă mulțumesc anticipat pentru ajutor și sfaturi.

Sub UpdateVisioTemplate()
Dim vDocs As Visio.Documents  'Documents collection of instance.
Dim vsoDoc As Visio.Document  'Document to work in
Dim vsoPage As Visio.Page     'Page to work in.
Dim vsoPages As Visio.Pages   'Pages collection of document.
Dim vApp As Visio.Application 'Declare an Instance of Visio.
Dim vsoShape As Visio.Shape   'Instance of master on page.
Dim vsoCharacters As Visio.Characters
Dim DiagramServices As Integer

Dim VarRow As Long
Dim FileName, DocName, VarName, VarValue, SiteID, SiteType, Wave, SiteName As String
'Dim vContent As Word.Range
With ActiveSheet
    DocName = .Cells(1, 6).Value
    SiteType = .Cells(1, 25).Value
    SiteID = .Cells(20, 5).Value
    SiteName = .Cells(21, 5).Value
            
    On Error Resume Next  'Check if Visio is already running
    'Set vApp = CreateObject("Visio.Application")
    Set vApp = GetObject(, "Visio.Application")
    If Err.Number <> 0 Then    'not equal to 0
        Err.Clear
        Set vApp = CreateObject("Visio.Application")
    End If
    vApp.Visible = True
    Set vDocs = vApp.Documents.OpenEx(DocName, &H1)
    '(DocName)
    'Set vDocs = vApp.Documents.Open(DocName)
    Set vsoPages = vApp.ActiveDocument.Pages
    
    DiagramServices = vApp.ActiveDocument.DiagramServicesEnabled
    vApp.ActiveDocument.DiagramServicesEnabled = visServiceVersion140

    LastRow = .Range("A999").End(xlUp).Row
    For Each vsoPage In vsoPages
        For VarRow = 2 To LastRow 'from Row 2 to the last row
            For Each vsoShape In vsoPage.Shapes
                VarName = .Cells(VarRow, 1).Value  'VariableName
                VarValue = .Cells(VarRow, 2).Value 'VariableValue
                If Len(VarValue) = 0 Then   'If the variable value is blank, keep the variable in place
                    VarValue = .Cells(VarRow, 1).Value
                End If
                Set vsoCharacters = vsoShape.Charaters
                vsoCharacters.Text = Replace(vsoCharacters.Text, VarName, VarValue)  'Find and replace the variables with the appropriate value
            Next vsoShape
        Next VarRow
    Next vsoPage
End With 'Active Sheet
vDoc.SaveAs (SiteID & ".vsd")
End Sub

Exemplu de date din Excel

Model de diagramă Visio

Diagramă Visio finală

Comentarii

  • Unele dintre numele variabilelor din fișierul Excel nu corespund exact numelor de pe formele Visio. De exemplu, Excel are {RTR-1-LAN-INT1} dar Visio are {RTR1-LAN-INT1}. Încercați să corectați numele care sunt greșite și vedeți dacă vă ajută –  > Por barrowc.
  • Vă mulțumim pentru sugestie. Cred că s-ar putea să fi făcut poza înainte de a mă asigura că totul se potrivește. Chiar și pentru valorile care se potrivesc, valoarea nu este actualizată. –  > Por maleante.
1 răspunsuri
Brian Moriarty

Un lucru pe care l-am observat a fost pe linia Set vsoCharacters = vsoShape.Charaters – aceasta din urmă ar trebui să fie vsoShape.Characters în loc de Charaters – din moment ce aceasta a fost în esență setată la blank (nimic), atunci nu a existat nimic de „înlocuit” și nu s-a schimbat nimic.

Motivul pentru care acest lucru nu a apărut este pentru că declarația „on error resume next” a fost făcută mai devreme, care suprimă mesajele de eroare și pur și simplu continuă.

Comentarii

  • Mulțumesc @brian-moriarty, asta a fost tot. –  > Por maleante.

Tags:, ,