Sujet Précédent Sujet Suivant

Des macros Excel (VBA) dans le tableur Google (ou autre tableur en ligne)

Dioul2 Messages postés 8 Date d'inscription mardi 21 octobre 2008 Statut Membre Dernière intervention 2 avril 2009 - 12 nov. 2008 à 18:11
us_30 Messages postés 2065 Date d'inscription lundi 11 avril 2005 Statut Membre Dernière intervention 14 mars 2016 - 13 nov. 2008 à 18:25
Bonjour,

J'ai beau chercher, je ne trouve pas la réponse à ma question.
J'ai fait un document sur Excel avec des macros. je souhaite le partager en ligne avec d'autres personnes.

Il semble que Google doc ne me permet pas d'avoir des macros.
Connaissez-vous un moyen de partager ce fichier (lecture et modification) directement en ligne?

Je vous remercie de vos réponses,

Dioul

6 réponses

Réponse 1 / 6
gillardg Messages postés 3275 Date d'inscription jeudi 3 avril 2008 Statut Membre Dernière intervention 14 septembre 2014 2
12 nov. 2008 à 20:27
Bonjour,

j'ai lu quelque part que microsoft prépare un genre de "office on line"
vas voir sur le site office !

a+
0
Réponse 2 / 6
us_30 Messages postés 2065 Date d'inscription lundi 11 avril 2005 Statut Membre Dernière intervention 14 mars 2016 10
13 nov. 2008 à 15:15
Bonjour,

JE n'utilise pas trop le partage en ligne, mais l'enregistrement sous "Page Web" permet plusieurs possibilités de partage... C'est une piste à regarder de plus près.

Amicalement,
Us.
0
Réponse 3 / 6
cs_loulou69 Messages postés 672 Date d'inscription mercredi 22 janvier 2003 Statut Membre Dernière intervention 2 juin 2016 1
13 nov. 2008 à 17:25
bonjour


Tu peux peut-être nous présenter le code de tes macros Excel et on t'expliquera comment le convertir en programme exécutable et téléchargeable sur le Web en l'adaptant à VB6.

Depuis VB6 on peut piloter excel mais peut-être n'est-ce même pas utile.
0
Réponse 4 / 6
Dioul2 Messages postés 8 Date d'inscription mardi 21 octobre 2008 Statut Membre Dernière intervention 2 avril 2009
13 nov. 2008 à 17:54
Voici la majeure partie de mes macros (c'est un peu long, donc je m'excuse d'avance):

Sub mandat()
'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
    Dim docWord As Word.Document
    Dim appWord As Word.Application
    Dim NomBase As String, NomDoc As String, Lettre As String
       
    NomBase = ActiveWorkbook.FullNameURLEncoded
    Lettre = "C:\Documents and Settings\EKV380\Bureau\Bureau\Personnel\TI\Modèle de courrier\Mandat.doc"
   
    If Dir(Lettre) <> "" Then
    NomDoc = Lettre
    Else
    NomDoc = "C:\Documents and Settings\EKV380\Bureau\Mandat.doc"
    End If
   
    Application.ScreenUpdating = False
    Set appWord = New Word.Application
    appWord.Visible = True
    'Ouverture du document principal Word
    Set docWord = appWord.Documents.Open(NomDoc)
   
    'fonctionnalité de publipostage pour le document spécifié
    With docWord.mailMerge
                'Ouvre la base de données
                .OpenDataSource Name:=NomBase, _
            Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
            "DBQ=" & NomBase & "; ReadOnly=True;", _
            SQLStatement:="SELECT * FROM [Feuil1$]"
        'Spécifie la fusion vers l'imprimante
        .Destination = wdSendToNewDocument
        .suppressBlankLines = True
            'Prend en compte l'ensemble des enregistrements
            With .DataSource
                .firstRecord = wdDefaultFirstRecord
                .lastRecord = wdDefaultLastRecord
            End With
        'Exécute l'opération de publipostage
        .Execute Pause:=False
    End With
   
    docWord.Close
    Application.ScreenUpdating = True
   
End Sub
Sub Mail()
'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
    Dim docWord As Word.Document
    Dim appWord As Word.Application
    Dim NomBase As String, NomDoc As String, Lettre As String
       
    NomBase = ActiveWorkbook.FullNameURLEncoded
    Lettre = "C:\Documents and Settings\EKV380\Bureau\Bureau\Personnel\TI\Modèle de courrier\Mail acceptation.doc"
   
    If Dir(Lettre) <> "" Then
    NomDoc = Lettre
    Else
    NomDoc = "C:\Documents and Settings\EKV380\Bureau\Mandat.doc"
    End If
   
    Application.ScreenUpdating = False
    Set appWord = New Word.Application
    appWord.Visible = True
    'Ouverture du document principal Word
    Set docWord = appWord.Documents.Open(NomDoc)
    With docWord.mailMerge
                'Ouvre la base de données
                .OpenDataSource Name:=NomBase, _
            Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
            "DBQ=" & NomBase & "; ReadOnly=True;", _
            SQLStatement:="SELECT * FROM [Feuil1$]"
        'Spécifie la fusion vers l'imprimante
        .Destination = wdSendToNewDocument
        .suppressBlankLines = True
            'Prend en compte l'ensemble des enregistrements
            With .DataSource
                .firstRecord = wdDefaultFirstRecord
                .lastRecord = wdDefaultLastRecord
            End With
        'Exécute l'opération de publipostage
        .Execute Pause:=False
    End With
   
    docWord.Close
    Application.ScreenUpdating = True
   
End Sub
Sub lettre1plusieurspax()
'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
    Dim docWord As Word.Document
    Dim appWord As Word.Application
    Dim NomBase As String, NomDoc As String, Lettre As String
    Dim rngTrouve As Range
    Dim strChaine As String
    Dim cell As String
    Application.ScreenUpdating = False
   
'Ajout BDD courrier'
     
i = Sheets("BDD courrier").Cells(65535, 1).End(xlUp).Row
Sheets("Index").Range("C7").Copy
Sheets("BDD courrier").Range("A" & i + 1).PasteSpecial Paste:=xlPasteValues


Sheets("BDD courrier").Range("B" & i + 1) = Date


Application.CutCopyMode = False
 
'Tri par ordre alphabetique'
Sheets("BDD courrier").Select
    Cells.Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Sheets("Index").Select
    Range("C6").Select
 
 
    NomBase = ActiveWorkbook.FullNameURLEncoded
    Lettre = "C:\Documents and Settings\EKV380\Bureau\Bureau\Personnel\TI\Modèle de courrier\Modèle Lettre 1.doc"
   
    If Dir(Lettre) <> "" Then
    NomDoc = Lettre
    Else
    NomDoc = "C:\Documents and Settings\EKV380\Bureau\Mandat.doc"
    End If
   
   
    Set appWord = New Word.Application
    appWord.Visible = True
    'Ouverture du document principal Word
    Set docWord = appWord.Documents.Open(NomDoc)
   
    'fonctionnalité de publipostage pour le document spécifié
    With docWord.mailMerge
                'Ouvre la base de données
                .OpenDataSource Name:=NomBase, _
            Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
            "DBQ=" & NomBase & "; ReadOnly=True;", _
            SQLStatement:="SELECT * FROM [Feuil1$]"
        'Spécifie la fusion vers l'imprimante
        .Destination = wdSendToNewDocument
        .suppressBlankLines = True
            'Prend en compte l'ensemble des enregistrements
            With .DataSource
                .firstRecord = wdDefaultFirstRecord
                .lastRecord = wdDefaultLastRecord
            End With
        'Exécute l'opération de publipostage
        .Execute Pause:=False
    End With
   
    docWord.Close
    Application.ScreenUpdating = True
   
End Sub




Sub relance()
'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
    Dim docWord As Word.Document
    Dim appWord As Word.Application
    Dim NomBase As String, NomDoc As String, Lettre As String
    Dim rngTrouve As Range
    Dim strChaine As String
    Dim cell As String
   
'Ajout BDD courrier'
     
    strChaine = Sheets("Index").Range("C7")
    Set rngTrouve = Worksheets("BDD courrier").Columns(1).Cells.Find(what:=strChaine)
   
    If rngTrouve Is Nothing Then
        MsgBox "N'existe pas dans la base!"
    Else
     cell = rngTrouve.Address
    End If
  
  Sheets("BDD courrier").Range("C" & rngTrouve.Row) = Date
 
 
    NomBase = ActiveWorkbook.FullNameURLEncoded
    Lettre = "C:\Documents and Settings\EKV380\Bureau\Bureau\Personnel\TI\Modèle de courrier\Relance.doc"
   
    If Dir(Lettre) <> "" Then
    NomDoc = Lettre
    Else
    NomDoc = "C:\Documents and Settings\EKV380\Bureau\Mandat.doc"
    End If
   
    Application.ScreenUpdating = False
    Set appWord = New Word.Application
    appWord.Visible = True
    'Ouverture du document principal Word
    Set docWord = appWord.Documents.Open(NomDoc)
   
    'fonctionnalité de publipostage pour le document spécifié
    With docWord.mailMerge
                'Ouvre la base de données
                .OpenDataSource Name:=NomBase, _
            Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
            "DBQ=" & NomBase & "; ReadOnly=True;", _
            SQLStatement:="SELECT * FROM [Feuil1$]"
        'Spécifie la fusion vers l'imprimante
        .Destination = wdSendToNewDocument
        .suppressBlankLines = True
            'Prend en compte l'ensemble des enregistrements
            With .DataSource
                .firstRecord = wdDefaultFirstRecord
                .lastRecord = wdDefaultLastRecord
            End With
        'Exécute l'opération de publipostage
        .Execute Pause:=False
    End With
   
    docWord.Close
    Application.ScreenUpdating = True
   
End Sub


Sub lettre2()
'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
    Dim docWord As Word.Document
    Dim appWord As Word.Application
    Dim NomBase As String, NomDoc As String, Lettre As String
    Dim rngTrouve As Range
    Dim strChaine As String
    Dim cell As String
   
'Ajout BDD courrier'
     
    strChaine = Sheets("Index").Range("C7")
    Set rngTrouve = Worksheets("BDD courrier").Columns(1).Cells.Find(what:=strChaine)
   
    If rngTrouve Is Nothing Then
        MsgBox "N'existe pas dans la base. Le Mandat a-t-il été fait?"
    Else
     cell = rngTrouve.Address
    End If
  
  Sheets("BDD courrier").Range("E" & rngTrouve.Row) = Date
 
 
 
    NomBase = ActiveWorkbook.FullNameURLEncoded
    Lettre = "C:\Documents and Settings\EKV380\Bureau\Bureau\Personnel\TI\Modèle de courrier\Modèle Lettre 2.doc"
   
    If Dir(Lettre) <> "" Then
    NomDoc = Lettre
    Else
    NomDoc = "C:\Documents and Settings\EKV380\Bureau\Modèle Lettre 2.doc"
    End If
   
    Application.ScreenUpdating = False
    Set appWord = New Word.Application
    appWord.Visible = True
    'Ouverture du document principal Word
    Set docWord = appWord.Documents.Open(NomDoc)
   
    'fonctionnalité de publipostage pour le document spécifié
    With docWord.mailMerge
                'Ouvre la base de données
                .OpenDataSource Name:=NomBase, _
            Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
            "DBQ=" & NomBase & "; ReadOnly=True;", _
            SQLStatement:="SELECT * FROM [Feuil1$]"
        'Spécifie la fusion vers l'imprimante
        .Destination = wdSendToNewDocument
        .suppressBlankLines = True
            'Prend en compte l'ensemble des enregistrements
            With .DataSource
                .firstRecord = wdDefaultFirstRecord
                .lastRecord = wdDefaultLastRecord
            End With
        'Exécute l'opération de publipostage
        .Execute Pause:=False
    End With
   
    docWord.Close
    Application.ScreenUpdating = True
   
End Sub


Sub derniercourrier()
'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
    Dim docWord As Word.Document
    Dim appWord As Word.Application
    Dim NomBase As String, NomDoc As String, Lettre As String
    Dim rngTrouve As Range
    Dim strChaine As String
    Dim cell As String
   
'Ajout BDD courrier'
     
    strChaine = Sheets("Index").Range("C7")
    Set rngTrouve = Worksheets("BDD courrier").Columns(1).Cells.Find(what:=strChaine)
   
    If rngTrouve Is Nothing Then
        MsgBox "N'existe pas dans la base. Le Mandat a-t-il été fait?"
    Else
     cell = rngTrouve.Address
    End If
  
  Sheets("BDD courrier").Range("G" & rngTrouve.Row) = Date
 
 
 
    NomBase = ActiveWorkbook.FullNameURLEncoded
    Lettre = "C:\Documents and Settings\EKV380\Bureau\Bureau\Personnel\TI\Modèle de courrier\derniercourrier.doc"
   
    If Dir(Lettre) <> "" Then
    NomDoc = Lettre
    Else
    NomDoc = "C:\Documents and Settings\EKV380\Bureau\Mandat.doc"
    End If
   
    Application.ScreenUpdating = False
    Set appWord = New Word.Application
    appWord.Visible = True
    'Ouverture du document principal Word
    Set docWord = appWord.Documents.Open(NomDoc)
   
    'fonctionnalité de publipostage pour le document spécifié
    With docWord.mailMerge
                'Ouvre la base de données
                .OpenDataSource Name:=NomBase, _
            Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
            "DBQ=" & NomBase & "; ReadOnly=True;", _
            SQLStatement:="SELECT * FROM [Feuil1$]"
        'Spécifie la fusion vers l'imprimante
        .Destination = wdSendToNewDocument
        .suppressBlankLines = True
            'Prend en compte l'ensemble des enregistrements
            With .DataSource
                .firstRecord = wdDefaultFirstRecord
                .lastRecord = wdDefaultLastRecord
            End With
        'Exécute l'opération de publipostage
        .Execute Pause:=False
    End With
   
    docWord.Close
    Application.ScreenUpdating = True
   
End Sub
Sub miseendemeure()
'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
    Dim docWord As Word.Document
    Dim appWord As Word.Application
    Dim NomBase As String, NomDoc As String, Lettre As String
    Dim rngTrouve As Range
    Dim strChaine As String
    Dim cell As String
   
'Ajout BDD courrier'
     
    strChaine = Sheets("Index").Range("C7")
    Set rngTrouve = Worksheets("BDD courrier").Columns(1).Cells.Find(what:=strChaine)
   
    If rngTrouve Is Nothing Then
        MsgBox "N'existe pas dans la base. Le Mandat a-t-il été fait?"
    Else
     cell = rngTrouve.Address
    End If
  
  Sheets("BDD courrier").Range("I" & rngTrouve.Row) = Date
 
 
 
    NomBase = ActiveWorkbook.FullNameURLEncoded
    Lettre = "C:\Documents and Settings\EKV380\Bureau\Bureau\Personnel\TI\Modèle de courrier\mise demeure.doc"
   
    If Dir(Lettre) <> "" Then
    NomDoc = Lettre
    Else
    NomDoc = "C:\Documents and Settings\EKV380\Bureau\Mandat.doc"
    End If
   
    Application.ScreenUpdating = False
    Set appWord = New Word.Application
    appWord.Visible = True
    'Ouverture du document principal Word
    Set docWord = appWord.Documents.Open(NomDoc)
   
    'fonctionnalité de publipostage pour le document spécifié
    With docWord.mailMerge
                'Ouvre la base de données
                .OpenDataSource Name:=NomBase, _
            Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
            "DBQ=" & NomBase & "; ReadOnly=True;", _
            SQLStatement:="SELECT * FROM [Feuil1$]"
        'Spécifie la fusion vers l'imprimante
        .Destination = wdSendToNewDocument
        .suppressBlankLines = True
            'Prend en compte l'ensemble des enregistrements
            With .DataSource
                .firstRecord = wdDefaultFirstRecord
                .lastRecord = wdDefaultLastRecord
            End With
        'Exécute l'opération de publipostage
        .Execute Pause:=False
    End With
   
    docWord.Close
    Application.ScreenUpdating = True
   
End Sub
Sub incrementer()
Dim A As Range, B As Range, C As Range, D As Range, E As Range
Application.ScreenUpdating = False


With Sheets("Index")
    Set A = .Range("E7:G7")
    Set B = .Range("E8:G8")
    Set C = .Range("E9:G9")
    Set D = .Range("E10:G10")
    Set E = .Range("C6:C21")
   
.Range("C7").Select
End With


With Sheets("client")


i = .Cells(65535, 1).End(xlUp).Row


A.Copy
.Range("Q" & i + 1).PasteSpecial Paste:=xlPasteValues


B.Copy
.Range("T" & i + 1).PasteSpecial Paste:=xlPasteValues


C.Copy
.Range("W" & i + 1).PasteSpecial Paste:=xlPasteValues


D.Copy
.Range("Z" & i + 1).PasteSpecial Paste:=xlPasteValues


E.Copy
.Range("A" & i + 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True


End With


Application.CutCopyMode = False
Application.ScreenUpdating = True


End Sub


Sub recherche()


    Dim rngTrouve As Range
    Dim A As Range
    Dim B As Range
    Dim C As Range
    Dim D As Range
    Dim strChaine As String
    Dim Ligne As Long
    Application.ScreenUpdating = False
    strChaine = InputBox("Nom à rechercher :")
    
    With Sheets("client")
        Set rngTrouve = .Columns(2).Find(strChaine, , , , xlByColumns, xlPrevious, False)
       
        If rngTrouve Is Nothing Then
            Application.ScreenUpdating = True
            MsgBox "N'existe pas encore"
            Exit Sub
        Else
            Ligne = rngTrouve.Row
        End If
      
        Set A = .Range("A" & Ligne & ":P" & Ligne)
        Set B = Union(.Range("Q" & Ligne), .Range("T" & Ligne), .Range("W" & Ligne), .Range("Z" & Ligne))
        Set C = Union(.Range("S" & Ligne), .Range("V" & Ligne), .Range("Y" & Ligne), .Range("AB" & Ligne))
        Set D = Union(.Range("R" & Ligne), .Range("U" & Ligne), .Range("X" & Ligne), .Range("AA" & Ligne))
    End With


    With Sheets("Index")
        A.Copy
        .Range("C6").PasteSpecial Paste:=xlPasteValues, Transpose:=True
   
        B.Copy
        .Range("E7").PasteSpecial Paste:=xlPasteValues, Transpose:=True
   
        C.Copy
        .Range("G7").PasteSpecial Paste:=xlPasteValues, Transpose:=True
       
        D.Copy
        .Range("F7").PasteSpecial Paste:=xlPasteValues, Transpose:=True
   
    .Range("C7").Select
    End With


    Set rngTrouve = Nothing
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub


Sub complete()


    Dim rngTrouve As Range
    Dim strChaine As String
    Dim Ligne As Long
    Dim A As Range, B As Range, C As Range, D As Range, E As Range
   
Application.ScreenUpdating = False
   
 With Sheets("Index")
 
 strChaine = .Range("C7")
    Set A = .Range("C6:C21")
    Set B = .Range("E7:G7")
    Set C = .Range("E8:G8")
    Set D = .Range("E9:G9")
    Set E = .Range("E10:G10")
   
.Range("C7").Select
   
End With
 
With Sheets("client")


    Set rngTrouve = Worksheets("client").Columns(2).Cells.Find(what:=strChaine)
   
    If rngTrouve Is Nothing Then
Application.ScreenUpdating = True
        MsgBox "N'apparaît pas dans la base. Merci de cliquer sur le bouton Valider"
    Else
     Ligne = rngTrouve.Row
    End If
          
A.Copy
.Range("A" & rngTrouve.Row).PasteSpecial Paste:=xlPasteValues, Transpose:=True


B.Copy
.Range("Q" & rngTrouve.Row).PasteSpecial Paste:=xlPasteValues


C.Copy
.Range("T" & rngTrouve.Row).PasteSpecial Paste:=xlPasteValues


D.Copy
.Range("W" & rngTrouve.Row).PasteSpecial Paste:=xlPasteValues


E.Copy
.Range("Z" & rngTrouve.Row).PasteSpecial Paste:=xlPasteValues


End With


Application.CutCopyMode = False
Application.ScreenUpdating = True


Set rngTrouve = Nothing
End Sub
Sub completerecap()


    Dim rngTrouve As Range
    Dim strChaine As String
    Dim Ligne As Long
    Dim A As Range, B As Range, C As Range, D As Range, W As Range, X As Range, Y As Range, Z As Range
   
   
Application.ScreenUpdating = False


With Sheets("Index")


strChaine = .Range("C7")
    Set A = .Range("G19")
    Set B = .Range("G21")
    Set C = .Range("G23")
    Set D = .Range("G25")
   
.Range("C7").Select
End With
   
With Sheets("BDD courrier")


    Set rngTrouve = .Columns(1).Cells.Find(what:=strChaine)
   
    If rngTrouve Is Nothing Then
Application.ScreenUpdating = True
        MsgBox "N'apparaît pas dans la base. Merci de cliquer sur le bouton Valider"
    Else
     Ligne = rngTrouve.Row
    End If
   
Set X = .Range("D" & rngTrouve.Row)
Set Y = .Range("F" & rngTrouve.Row)
Set Z = .Range("H" & rngTrouve.Row)
Set W = .Range("J" & rngTrouve.Row)


      
If X = "" Then
A.Copy
X.PasteSpecial Paste:=xlPasteValues
Else
X = X
End If


If Y = "" Then
B.Copy
Y.PasteSpecial Paste:=xlPasteValues
Else
Y = Y
End If


If Z = "" Then
C.Copy
Z.PasteSpecial Paste:=xlPasteValues
Else
Z = Z
End If


If W = "" Then
D.Copy
W.PasteSpecial Paste:=xlPasteValues
Else
W = W
End If
End With


Application.CutCopyMode = False
Application.ScreenUpdating = True


Set rngTrouve = Nothing
End Sub
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 6
cs_loulou69 Messages postés 672 Date d'inscription mercredi 22 janvier 2003 Statut Membre Dernière intervention 2 juin 2016 1
13 nov. 2008 à 18:15
Je vois une application de publipostage d'une lettre Word avec comme base un fichier Excel qui sert aussi à la relance client.


Et bien je ne vois pas de solution mais je ne suis pas tout à fait un expert.


Sauf à tout refaire sous forme d'une application Web (Php+MySql) chez un fournisseur comme free, ou en Visual Studio .Net (ASP.Net +SQLServer)


Donc, sous toute réserve, publier ce projet sous format Web et faire tourner les macros , il faut oublier.
0
Réponse 6 / 6
us_30 Messages postés 2065 Date d'inscription lundi 11 avril 2005 Statut Membre Dernière intervention 14 mars 2016 10
13 nov. 2008 à 18:25
Je ne vois pas en quoi le listing apporte un élément supplémentaire pour répondre à la première (et unique) question ?

Qu'on aurait un Msgbox "bonjour toto", cela ne changerait rien au pb posé.

Perso, je ne vais pas me répéter...

Bon courage,
Amicalement,
Us.
0

Discussions similaires

Dernière cellule non vide d'une colonne
cs_falafala -
Luigi13013 -

5 réponses
Selection derniere cellule non vide plage cellule Excel
gregfred8cs -
pile_poil -

2 réponses
Vba dernière cellule non vide (Ignorer les formules résultat "")
djidji094 -
djidji094 -

5 réponses
Dernière ligne d'une colonne excel
Portmand -
Portmand -

21 réponses
fonction modulo en VBA
krisprolss -
Benouille -

2 réponses
Rejoignez-nous