Des macros Excel (VBA) dans le tableur Google (ou autre tableur en ligne)
Dioul2
Messages postés8Date d'inscriptionmardi 21 octobre 2008StatutMembreDernière intervention 2 avril 2009
-
12 nov. 2008 à 18:11
us_30
Messages postés2065Date d'inscriptionlundi 11 avril 2005StatutMembreDernière intervention14 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
A voir également:
Des macros Excel (VBA) dans le tableur Google (ou autre tableur en ligne)
us_30
Messages postés2065Date d'inscriptionlundi 11 avril 2005StatutMembreDernière intervention14 mars 201610 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.
cs_loulou69
Messages postés672Date d'inscriptionmercredi 22 janvier 2003StatutMembreDernière intervention 2 juin 20161 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.
Dioul2
Messages postés8Date d'inscriptionmardi 21 octobre 2008StatutMembreDerniè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
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
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
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
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