Как я могу прочитать флажок? - PullRequest
0 голосов
/ 07 мая 2020

Как я могу прочитать автоматически сгенерированные флажки, и если для флажка установлено значение "True", сохранить имя флажка в автоматически сгенерированной переменной.

Цель макроса: Для однократного сохранения последовательных букв я хочу, чтобы пользователь мог определять имена различных документов. Поэтому я создал UserForm, в котором перечислены все возможные имена (все столбцы в Excel). Например, если человек выбирает два столбца (имя и фамилия), он или она будет использовать содержимое этого столбца для сохранения.

Пример: Имя и фамилия -> Liam_Smith.pdf -> Emma_Johnson.pdf

важная часть кода

'################################################ --> Hauptteil / Userform Name

    With ActiveDocument.MailMerge

            Dim myLabel As Object
            Dim myCheckBox As Object
            Dim y As Integer
            Dim ColumnCount As Integer
            Dim CaptionValue As String
            Load UserForm3


            'ColumnCount = ActiveDocument.MailMerge.DataSource.RecordCount
            ColumnCount = ActiveDocument.MailMerge.DataSource.FieldNames.Count
            'MsgBox (ColumnCount)

            For y = 1 To ColumnCount
            CaptionValue = (ActiveDocument.MailMerge.DataSource.DataFields(y).Name)

            Set myCheckBox = UserForm3.Controls.Add("Forms.CheckBox.1", "Test" & 1, True)
                With myCheckBox
                    .Name = "myCheckBox" & y
                    .Left = 24
                    .Top = (17.5 + (y * 20))
                End With

            Set myLabel = UserForm3.Controls.Add("Forms.Label.1", "Test" & 1, True)
                With myLabel
                .Caption = (CaptionValue)
                .Left = 54
                .Top = (20 + (y * 20))
                .Width = 50
                .Height = 12
            End With
            Next y

            Load UserForm3
            UserForm3.Show

    '################################################ --> CheckBox auswertung

        'For y = 1 To ColumnCount
            'If UserForm3.CheckBox.Value = True Then
                'MsgBox "True"
            'Else
                'MsgBox "False"
            'End If

весь код:

Sub SerienbriefOneDoc()
'
' SerienbriefOneDoc Makro
'
'
Dim Dateiname As String
Dim LetzterRec As Long
Application.ScreenUpdating = True
Application.Visible = False


'################################################ --> Speicherort

'Variable declaration
Dim sFolderName As String
Dim sDesktopPath As String, sFolderPath As String

'Find Desktop path location
sDesktopPath = Environ("USERPROFILE") & "\Desktop\"

'Define folder name to create on the desktop
sFolderName = "Serienbrief"

'Folder Path
sFolderPath = sDesktopPath & sFolderName

'Create FSO Object
Set oFSO = CreateObject("Scripting.FileSystemObject")

'Check Specified Folder exists or not
If oFSO.FolderExists(sFolderPath) Then
    'If folder is available on the desktop
    MsgBox "Der angegebene Ordner existiert bereits auf dem Desktop!", vbInformation, "VBAF1"
    GoTo PDFsave
Else
    'Create Folder
    MkDir sFolderPath

    'Diplay messafe on the screen
    MsgBox "Ordner erstellt : " & vbCrLf & vbCrLf & sFolderPath, vbInformation, "VBAF1"
End If


'################################################ --> Speicherort UserForm


'################################################ --> Makro einstellungen

PDFsave:

Dim isUpdating As Boolean
isUpdating = Application.ScreenUpdating

'we need ScreenUpdating toggled on to do this:
If Not isUpdating Then Application.ScreenUpdating = True

'if msg is empty, status goes to "Ready"
Application.StatusBar = msg

'make sure the update gets displayed (we might be in a tight loop)
DoEvents

'if ScreenUpdating was off, toggle it back off:
Application.ScreenUpdating = isUpdating

 ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord
 LetzterRec = Word.ActiveDocument.MailMerge.DataSource.ActiveRecord
 ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord

'################################################ --> Hauptteil / Userform Name

With ActiveDocument.MailMerge

        Dim myLabel As Object
        Dim myCheckBox As Object
        Dim y As Integer
        Dim ColumnCount As Integer
        Dim CaptionValue As String
        Load UserForm3


        'ColumnCount = ActiveDocument.MailMerge.DataSource.RecordCount
        ColumnCount = ActiveDocument.MailMerge.DataSource.FieldNames.Count
        'MsgBox (ColumnCount)

        For y = 1 To ColumnCount
        CaptionValue = (ActiveDocument.MailMerge.DataSource.DataFields(y).Name)

        Set myCheckBox = UserForm3.Controls.Add("Forms.CheckBox.1", "Test" & 1, True)
            With myCheckBox
                .Name = "myCheckBox" & y
                .Left = 24
                .Top = (17.5 + (y * 20))
            End With

        Set myLabel = UserForm3.Controls.Add("Forms.Label.1", "Test" & 1, True)
            With myLabel
            .Caption = (CaptionValue)
            .Left = 54
            .Top = (20 + (y * 20))
            .Width = 50
            .Height = 12
        End With
        Next y

        Load UserForm3
        UserForm3.Show

'################################################ --> CheckBox auswertung

    'For y = 1 To ColumnCount
        'If UserForm3.CheckBox.Value = True Then
            'MsgBox "True"
        'Else
            'MsgBox "False"
        'End If

'################################################ --> Progressbar

     'MsgBox (.DataSource.RecordCount)
     .DataSource.ActiveRecord = wdFirstRecord


      Dim RecordCount As Integer
      Dim i As Integer, percent As Integer, ActiveDoc As Integer, ActivePercent As Integer
      Dim widthUpdate As Double, j As Double
      UserForm2.Label1.BackColor = &HFF00&
      percent = 100
      UserForm2.Label1.Width = 0
      RecordCount = .DataSource.RecordCount
      ActiveDoc = .DataSource.ActiveRecord
      i = 1

     Do
        i = i + 1
        j = i * percent / RecordCount
        widthUpdate = j * 2
        ActivePercent = j
        UserForm2.Label1.Width = widthUpdate
        UserForm2.Label2.Caption = ActivePercent & "% Complete"

         If .DataSource.ActiveRecord > 0 Then                                                                           
'Prueft ob es mehrere Seiten fuer den Serienbrief gibt
            If RecordCount <> "0" Then                                                                                  
'zaehlt die Anzahl Datensaetz in der Spalte "Name"
                 .Destination = wdSendToNewDocument
                 .SuppressBlankLines = True

                    If Dir(sFolderPath, vbDirectory) <> "" Then                                                         
'prueft ob es das Verzeichnis gibt.
                    Else
                        MsgBox "Verzeichnis existiert nicht"                                                            
'Fehlermeldung falls das Verzeichniss nicht existiert
                    End If
                 With .DataSource
                     .FirstRecord = .ActiveRecord
                     .LastRecord = .ActiveRecord
                        dname = sFolderPath & "\" & Name1 & "_" & Name2 & ".pdf"                                        
'erstellt eine Variable mit dem Pfad und dem Namen
                 End With
                    .Execute Pause:=False
                    ActiveDocument.SaveAs2 FileName:=dname, FileFormat:=wdFormatPDF                                     
'benennt die Datei und aendert das Dateiformat auf PDF
                    ActiveDocument.Close False                                                                          
'schliesst das Fenster
             End If
           End If
         If .DataSource.ActiveRecord < LetzterRec Then                                                                  
'prueft ob es noch eine Seite gibt im Serienbrief
             .DataSource.ActiveRecord = wdNextRecord                                                                    
'nimmt die naechste Seite des Serienbriefes
         Else
             Exit Do                                                                                                    
'wenn es keine Seite im Serienbrief mehr gibt wird die Schleife beendet
         End If
        UserForm2.Show (0)
        Load UserForm2
        DoEvents
        UserForm2.Repaint
     Loop
     Unload UserForm2
 End With

 Application.Visible = True
 Application.StatusBar = False
 Application.DisplayStatusBar = sBar
 Application.ScreenUpdating = True
End Sub

Моя UserForm

  1. UserForm_V1
  2. UserVorm_V2
  3. Excel_Record

1 Ответ

0 голосов
/ 07 мая 2020

Чтобы сохранить имя CheckBox в переменной, вы можете сделать что-то вроде:

Dim myCheckboxName as string
Dim Ctrl as Control

For each Ctrl in <UserForm>.MSForms.Controls
    If TypeName(Ctrl) = "CheckBox" then
        If Ctrl.Value = True Then
            myCheckboxName = Ctrl.Name
        End If
    End If
Next Ctrl

Имейте в виду, чтобы заменить ссылку на вашу форму, это будет l oop через все элементы управления в вашей пользовательской форме, поэтому, если установлено более одного флажка, это приведет к сохранению последнего отмеченного флажка, к которому осуществляется доступ в l oop, но это дает вам представление о том, как найти установлен и присвоить имя переменной.

Я бы посоветовал использовать заголовок на CheckBox вместо отдельного Label, чтобы упростить ссылки и поиск в вашем коде. Что-то вроде:

Set myCheckBox = UserForm3.Controls.Add("Forms.CheckBox.1", "Test" & 1, True)
    With myCheckBox
        .Name = "myCheckBox" & y
        .Caption = CaptionValue '<~~
        .Left = 24
        .Top = (17.5 + (y * 20))
    End With

Затем вы можете определить, какие из CheckBox будут проверены позже, и напрямую сослаться на его заголовок, вместо того, чтобы пытаться выработать хороший способ назвать / применить свои ярлыки, чтобы найти их как только вы найдете соответствующий флажок, который установлен.

Что-то вроде:

With UserForm3.CheckBox
    For y = 1 To ColumnCount
        If .Value = True Then
            MsgBox .Caption & " is checked."
        Else
            MsgBox .Caption & " is not checked."
        End If
    Next y
End with

Я не понимаю, для чего вы собираетесь использовать заголовок в своем коде, поэтому я использовал ваш тест l oop в приведенном здесь примере.

Вы можете применить тот же принцип, если хотите, чтобы он оставался таким же, как использование CheckBox и отдельного Label для подписи, но вам нужно будет разработать хороший способ, чтобы иметь возможность для ссылки на правильный Label.Caption, когда вы найдете отмеченные CheckBox, например, присвоите им одинаковый номер и проверьте, что свойство .Name совпадает с тем же номером, используя функцию Mid() или что-то в этом роде.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...