[Resolvido]Exportar dados de formulário e rotulo das colunas para excel

Bom dia
Este código faz parte um módulo para extrair dados de um formulário para o excel e está a funcionar, mas pretendia evitar que ele percorre-se todos os controles até que encontrasse a legenda correta.
Tem como substituir o código a vermelho por algo semelhante a este:
Dim ctl As Control
Dim NomeCampo As String
Set Ctl = "Rot" + Rd.Fields(i).Name
NomeCampo = ctl.Caption

------------------------------------------------------------

intCampos = Rd.Fields.count
For i = 0 To intCampos - 1
    Dim ctl As Control
    Dim NomeCampo As String
    NomeCampo = Rd.Fields(i).Name
    For Each ctl In Screen.ActiveForm.Controls              
          If ctl.Name = "Rot" + Rd.Fields(i).Name Then
          NomeCampo = ctl.Caption
          End If
    Next    
XPlanilha.Cells(2, i + 1).Value = NomeCampo
XPlanilha.Cells(2, i + 1).Font.Bold = True
Next i

Olá Rui,
Esse campos que mostra no formulário são de origem numa tabela ou consulta=
Se sim, podia fazer a leitura directamente na tabela ou consulta, apenas com os campo pretendidos e caso necessário até já filtrados.
Vai sugestão.
Abraço

Viva ahteixeira
Obrigado pela dica, mas o formulário está desvinculado, a origem dos dados é o Sql Server.
E eu pretendo que vá buscar para o nome da coluna do excel o rotulo da coluna do formulário e não o nome do campo.
Este método de exportar para o excel quando são muitos registos fica um bocado lento.
Vou também experimentar o seguinte procedimento para exportar para o excel via VBA:
1-Alterar formulário para vista de folha de dados
2-Selecionar todos os registos
3-Copiar
4-Abrir o excel
5-Colar
6-Voltar a colocar vista de formulário

Você sabe como posso alterar para vista de folha de dados e vista de formulário com VBA?
Abraço

Olá Rui, desconheço o comando em modo de execução.
No entanto os campos são do sql e desvinculado melhor.
Acha que consegue criar uma consulta com os dados como pretende exportar?
Poderia fazer como estava a proceder ou na minha opinião como exemplo abaixo:
https://social.msdn.microsoft.com/Forums/en-US/1e1bb4c6-fcca-4cbf-8b76-1a275ec22d7f/access-2003-vba-how-to-export-sql-select-result-in-excel-file-instead-of-access-listbox?forum=isvvba
Abraço

Viva ahteixeira
Obrigado pela dica, optei por utilizar o código abaixo que não requer novamente ligação ao servidor e fica muito rápido.
Pretendia resolver era a questão inicial, porque com este código e com o que você sugeriu ele assume como nome das colunas o nome do campo e eu quero que assuma a legenda do rotulo do formulário, exemplo:
Nome do campo da tabela: NomeProduto
Nome do rótulo no formulário: RotNomeProduto
Legenda do rótulo no formulário: Nome do Produto (É este valor que eu quero que passe para o excel como cabeçalho da coluna)

DoCmd.SetWarnings False
DoCmd.RunCommand acCmdSelectAllRecords
DoCmd.RunCommand acCmdCopy

Dim XPlanilha As Object
Set XPlanilha = CreateObject("Excel.Application")
XPlanilha.visible = True
XPlanilha.Workbooks.Add
XPlanilha.Workbooks(1).Sheets(1).Select

XPlanilha.Workbooks(1).Sheets(1).Paste
XPlanilha.Workbooks(1).Sheets(1).Columns("A:C").Delete
XPlanilha.Workbooks(1).Sheets(1).Cells.RowHeight = 16.5
XPlanilha.Workbooks(1).Sheets(1).Cells.EntireColumn.AutoFit

Aqui fica o código completo, a parte a vermelho é que fica lenta

DoCmd.SetWarnings False
DoCmd.RunCommand acCmdSelectAllRecords
DoCmd.RunCommand acCmdCopy

Dim XPlanilha As Object
Set XPlanilha = CreateObject("Excel.Application")
XPlanilha.visible = True
XPlanilha.Workbooks.Add
XPlanilha.Workbooks(1).Sheets(1).Select

XPlanilha.Workbooks(1).Sheets(1).Paste
XPlanilha.Workbooks(1).Sheets(1).Columns("A:C").Delete
XPlanilha.Workbooks(1).Sheets(1).Cells.RowHeight = 16.5

Dim i As Integer
Dim ctl As control
For i = 1 To NumCol
   For Each ctl In Screen.ActiveForm.Controls
   If Left(ctl.Name, 4) = "Rot" & i Then
   XPlanilha.Cells(1, i).Value = ctl.Caption
   End If
   XPlanilha.Cells(1, i).Font.Bold = True
   Next
Next i
 
XPlanilha.Workbooks(1).Sheets(1).Cells.EntireColumn.AutoFit

Olá, ainda bem que conseguiu resolver.
Relativamente à questão de ficar lento desconheço alternativa, vamos ver se mais algum colega aqui do fórum pode ajudar.
Em anexo, outra forma de exportar para excel, pode ser que ajude ou possa tirar novas ideias.
Testado em 2003 e 2010.
Abraço

Viva
Valeu por mais este exemplo.
Vou tentar resolver o problema do nome das colunas ficar igual ao nome das colunas do formulário.
Poderia atribuir o nome diretamente, mas a ideia é criar um modulo e servir para todos os formulários sem andar com alterações.
Abraço

Olá Rui, obrigado pelo retorno.
Se considera que está concluído, não se esqueça de dar o tópico como resolvido, veja link abaixo:
http://maximoaccess.forumeiros.com/t860-resolucao-de-topicos
Abraço

Viva
Resolvi com este código:

DoCmd.SetWarnings False
DoCmd.RunCommand acCmdSelectAllRecords
DoCmd.RunCommand acCmdCopy

Dim XPlanilha As Object
Set XPlanilha = CreateObject("Excel.Application")
XPlanilha.visible = False
XPlanilha.Workbooks.Add
XPlanilha.Workbooks(1).Sheets(1).Select

XPlanilha.Workbooks(1).Sheets(1).Paste
XPlanilha.Workbooks(1).Sheets(1).Columns("A:C").Delete
XPlanilha.Workbooks(1).Sheets(1).Cells.RowHeight = 16.5

Dim i As Integer
Dim ctl As control
Dim NomeCol As String

For Each ctl In Screen.ActiveForm.Controls
If ctl.Name Like "RotExcelC*" Then
NomeCol = ctl.Caption
i = Nz(Mid(ctl.Name, 10, 2))
XPlanilha.Cells(1, i).Value = NomeCol
XPlanilha.Cells(1, i).Font.Bold = True
End If
Next

XPlanilha.Workbooks(1).Sheets(1).Cells.EntireColumn.AutoFit
XPlanilha.Workbooks(1).Sheets(1).range("A1").Select
XPlanilha.visible = True

Olá, obridago pelo retorno e partilha como resolveu.
Os utilizadores do fórum agradecem.
Abraço